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INTBODUCflOM 

This guide describes an Implefflentation of a PascaL [1] compiler 
for IBM 360/370 series conputers. This project is in a sense 
incofflplete. Some features cf the full language have been omitted, 
because they were not necessary for th« completion of the bootstrap 
(from the CDC 6000 series computers £2]). Purthernore, there exist 
some known bugs and deficiencies in the system at the time of this 
writing. This manual is intended to act as a guide in modifying the 
compiler and correcting these errors. Since the compiler is written 
in PasCftL, and since the inplementation is fairly efficient, this 
partial system will be a good starting point for the implementation 
of a compiler for the complete language. 

The PASCAL compiler described here is a modification of the 
January 1972 version of the Pascai/6600 compiler. The basic 
structure of that compiler is described in [3], and should be well 
understood before re4ding this report. Only those modifications of 
the compiler that were necessary in converting the system to a new 
computer will be detailed here. Thus, emphasis will be placed on 
the run-time environment, the addressing mechanisms, the interfaces 
to the operating system, and similar items. 
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PBOJECT HISTORY ^ 

The work described in this report was started in the fall of ^ 

1971, when Professor Niklaas Wirth was visiting at Stanford, At ^ 
that time the authors, James Peterson, and Reinhard Wilhelm, all 

graduate students at Stanford, becane involved. Work progressed ^ 

slowly, due to other comaitoents, and by the summer of 1972, when * 
Wirth returned to Zurich, the compiler consisted of much undebugged 

code in both PL/I and PASCftL. Many of the statement handlers, as ^ 

well as the scanning routines and the declaration processing, had ^ 
been completed, 

at this point, Peterson and Wilhelm left the project, and no .^ 
work was done during the summer. In the fall, the authors resumed 

work, and were able to debug most of the PI/I code that then ^ 

existed. A simple monitor was written, and the first PASCAL ^ 
programs were correctly translated and run in December 1972, 

In January 1973 the first author left Stanford for six months, * 
and work was suspended until the spring of 1974, at which time Huby 

Lee joined the project. During the spring and summer, the remaining ^ 

features necessary for bootstrapping the compiler were added and ^ 
both the PASCAL and PL/I versions were completed and debugged. The 
compiler was successfully bootstrapped in July t97U, ■ ■ • M 

Subsequently, Ruby lee and the second author left the project, 

and the details of the compiler described in this report correspond ^ 

to the version in existence at that time. ^ 
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I^ANGUAGE DIFFEgEHCES 



g| The language implemented is the language described in the ^ 

original definition of PiSCai [ 1 ]» with the follouing exceptions: ^ 

g| - hexadecimal quantities may be specified ^ 

^ - braces { } to define ccmments are replaced by quotation marks ^ 

A - brackets [ ] to define powersets are replaced by the notation > ^ 

^ SET{..,) ^ 

- brackets C ] ^o define array subscript expressions are 

g| replaced by parentheses ( ) ^ 

^ - procedures and functions as formal parameters are not ~ 

implemented 
1^ - real arithmetic is not completely iaiplenented 

^ - powersets are not implemented 



- character I/O is not iiplemented 

- no EOL character is defined 

- not all arithmetic functions (SIN, COS, etc.) are implemented 

- PACKED records are not implemented 

Some of these changes clearly represent minor transliteration 
differences, and some represent features which were not implemented 
because they were not needed in order to complete the bootstrap to 
the 360/370. 
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IMPLBMENTATION DETftlLS 

In this section, the details of the implenentation of the 
October 1974 version of the compiler are described. Since it is 
structurally similar to the PftSCaL/eeOO compiler, only those parts 
of the conpiler in which substantial differences exist will be 

described. 

Many of the differences that do exist are due to the fact that 
one of the most important goals of this project was to maintain 
compatibility with the existing IBH operating systems. This implied 
that, as much as possible, the following requirements were met: 

- OS procedure call conventions were followed 

- OS input/output conventions were followed 

- OS object modules were generated 

- reentrant code was generated 

- seperate compilation of global level procedures was allowed 

- easy access to external program libraries was assured 

aith these goals met, a PASCAL program could automatically take 
advantage of the many services already offered by the operating 
system. In particular, 

- the FORTRAN library would be available for the mathematical 
functions 

- assembly language subroutines could be included 

- input/output routines would be easily accessible 

- the programs would run under OSVYI, a Stanford time-sharing 
service 

While not all of the goals listed above have been completed in 
the first version, the design of the compiler is such that their 
addition is expected to be quite easy, Huch of the following 
discussion will be centered around the facilities for interfacing to 
the operating system. 

Monitor 

The monitor is a short assembly language program whose sole 
duty is to set up the environment for the PASCAL code, and to 
receive error conditions from the object code. The monitor performs 
the following functions: 

1, Receives initial control from the operating system 

2, Does a GETMAIN to get core for the run-ti«e data area stack 

3, Releases some of this core back to the operating system, to 
be used for buffers, DCBs, etc. 

4, ,. Sets up the registers properly 
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5, Does a BALH to the maia program of the PASCSL code 

Runtime environment and register assigngent 

A ran-time stack is naintained in core. When a procedure (or 
function) is entered, a data area for that procedure is allocated 
from the stack area. The first 72 bytes of this data area are used 
for the OS save area, which is chained both forward and backward in 
standard OS style. The first word of the save area (which is unused 
in OS, except for Pt/I programs), contains the static link, i.e. the 
address of the data area of the lexically enclosing procedure. 

Parameters, if any, are placed into the data area starting at 
location 72 (after the save area). All other variables are assigned 
storage locations following the parameter list. No atteapt is made 
to optimize the location of variables; they are assigned addresses 
in the same order that they are declared. 

(Storage assignment at the global level is slightly different. 
There are no parameters, and space for f ixed-to-float conversions 
and for the predefined inptit and output files is reserved.) 

The compiler simulates a stack machine. Thus, the floating- 
point registers and some of the general purpose registers are used 
during execution to hold arithmetic quantities. The other general 
purpose registers are used to maintain the PASCAL environment, 

SO, 1 - temporary registers; contents may not be saved across a 

procedure call 
B2 - points to the top of the run-time stack (first free 

doubleword) 
H3,4 " base registers fcr the program segment 
as- 11 - execution stack for temporary arithmetic and address 

quantities 
B12 - points to the global data area 
R13 - points to the local data area 
H14,15- used for procedure calls, standard OS conventions 

A diagram of the run-time stack appears in Figure 1. 

Procedure entry and ^xit 

The procedure entry and exit code follows standard OS 

conventions, and in addition, does the necessary work to maintain 

the internal PASCAL environment. (Procedure aud function calls are 
described elsewhere.) 
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Procedure entry: 

Branch aroand entry id 

Length of entry id 

Entry id 

Align to instruction boundary 

Sill contain length of data area 

Save registers 

Program base register 

Second program base register 

Dynamic back link 
Dynamic forward link 
Address local data area 
Opdate pointer to top of stack 

In addition. 

Check for stack overflon, and exit if necessary 

If at global level, perform data initializations, if any 

Initialize files, if any 

Initialize classes, if any 

Procedure exit: 

Close files, if any 
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Data obje cts 

Data objects in the compiler have two attributes that affect 
the assignment of storage to them: length and alignment. The 
length and alignment of a variable are determined from the length 
and alignment of the corresponding type. For simple types, the 
alignment is equal to the length and represents the minimum space in 
bytes required to hold the item. Thus, for simple types, the 
following lengths (and alignments) are used: 
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^ char - byte aligned 

tagfield, subrange, constant, integer - either haifvord or 
m fullword aligned, depentding on the range of the quantity ^ 

^ pointer - fullword aligned ^ 

real - doubleword aligned 
^ Boolean - halfword aligned H 

The length and alignment of structured types is deternined from 
A the length and alignment of the component types. Procedure i H 

^ OPJDSTIFlf is used to perforta the alignoent function when required. 

(Note that for the IBM 370 series, data alignment is not necessary, 
H and thus procedure OPJUSTIFI may be replaced by a null procedure). H 

^ Structured types are assigned the largest alignment of any of their ! 

component types. Classes and files are doubleword aligned, Records 
g| are assigned the length of their largest variant part; PACKED ^ 

^ records are not implemented. 

D at a a ddressing 
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Cons-^ants 

Constants appearing in the PASCAL source may be any length 

allowed for simple types. Thus there are four separate constant 
g| tables which are maintained, for halfword, fullword, doubleword, and g| 

^ alfa constants. In addition, a table for external references is ^ 

kept. To help in using these constants, a definition of a 
A 'constant* type was added: ' M 

TYPE CONSfKIND = (INTEGERS, SEALS, ALFAS, CHARS, 
^ SYMBOLICS, EXTHEF) ; ^ 

• CONST = RECORD CASE KONSTKIND: CONSTKIND OF * 

INTEGERS: CHARS: SYHBOLICS: (I¥ALOE: INTEGER); 
^ REALS: {RVALUE: REAL) ; A 

^ ALFAS: (A?ALOE: ALFA) ; ^ 

EXTREF: (EVALOE: ALFA); 
^ END; 

In addition, two procedures were defined: 

^ PROCEDDRE LDCST2(FVAL: CONSTANT; FRP:SHRTINT) ; ^ 

PROCEDURE LDCST(FVAL: CONSTANT); 



LDCST2 loads a constant into a given register, and LDCST loads 
a constant onto the top of the register stack. The actual constant 
values are placed in the program segment, after the exit code for 
that procedure, V-type external references may be loaded by loading 
a constant where KONSTKIND=EXTBEP, and the name of the external 
reference has been assigned to EVALUE, Appropriate ESD and RLD 
entries will then be made in the object deck. 



Ext.ern.al..,„names and , labe l ,,,, proces sing 

Each procedure is written out as a separate CSECT. However, 
because of the PASCAL scope rules, the name of a procedure is not 
sufficient to identify it to the system at link edit time. 
Therefore, every procedure, function, and exit label is assigned an 
external name which is unigue to the program being compiled. This 
name is constructed by appending characters from a given sequence to 
a root, which is obtained from the name of the enclosing global 
level procedure. This allows global level procedures to be 
separately compiled, and linkedited with the rest of the object (or 
load) module. <0f course, the global declarations must remain 
constant) , A new field SDNAHI in the contexttable for procedures 
and functions contains the external name that has been constructed 
for the procedure or function. 
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Since exit labels must be declared, there is no problem in 
assigning them an external name. These external names are entered 
into array EXTAB of exit labels. Jumps to exit labels generate the 
adjustment of the runtime stack to maintain the environment of the 
target location, followed by a load of the external name (using 
LDCST2) , and finally a branch. Ordinary jumps generate a simple 
branch instruction; undefined label references are chained through 
the code until defined by the occurrence of the label. 



Global data 



at the global level only, initial values may be declared for 
global variables. In order to maintain reentrancy, this data is 
compiled into a separate CSECT with external name SGBLDAT. It is 
then copied by the global level procedure entry code into the 
runtime stack, before preceding with execution. 






Input/output 



h file is described by a 16 byte file control block (FCB) . 
FCB is defined as follows: 
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File Control Block 
Pointer to buffer 

in PASCAL data area 
File naae 

LlECL according to PASCAL 
Buffer follows FCB 
Open flag 

Overwritten in open code 
Pointer to save area and DCB 
Number of char left in buffer 
(Character files only) 

Save area and DCB 



DSOSG=PS, (PH) Or (GH) , if get 

For the very siaple-minded I/O modules currently 
the following must be kept in mind: 



implemented. 



- The buffer must follow the FCB, and location in the FCB 
must point at it. The length of a file is thus (16 + the 
length of the buffer). The file, i.e. the FCB, is doubleword 
aligned. 



The filename must be at location H of the FCB. The 
characters are the OS ddnaae. 
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The buffer length must be in location 14 of the FCB, and must 
equal the Irecl defined in the JCL. Further, the high-order 
bit of this field must be a 0, 

Hhen the I/O routine is first entered, a work area is 
obtained, and an OS OPEN macro is executed. If the open is 
successful, the address of the workarea will be stored into 
the FCB, overwriting the first four bytes of the filename. 
In addition, the high-order bit of the Irecl field will be 
set to indicate that the file has been opened. 

The I/O routines expect to gain control with the address of 
the FCB in 11. LDCST2 is used to load the proper module 
entry point, which, for record files, is either PSCLGETl or 
PSCLFUTl. 
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Character files are not currently impleaented, but may be 
simulated in the following manner: 

TYPE CARD = ARRAY (1..80) OF CHAR; 

VAR SYSIN: FILE OF CARD; I: INTEGER; C: CHAR; 

GET(SYSIN); 

C := SYSIN (I); "ITH , CHARACTER OF THE INPUT CARD" 

Procedu re and function calls 

The argument list is constructed starting at location 72 past 
register 2. The arguments will then be in the data area of the 
called procedure. VAR parameters and structured parameters are 
passed by reference. CONST parameters of simple type are passed by 
value. 

The returned value of a function is stored in the data area of 
the calling procedure. The first parameter of the function is 
implicitly defined to be a pointer to the returned value. In the 
case of nested function calls, the value of the stacktop pointer in 
12 is adjusted so that the partially constructed parameter list will 
not be overwritten by a function call within the argument list. 

After the parameters have been set up, the static link is 
fixed, and the procedure is then called, using the external name 
stored in field SDNAME of the contexttable. 



Classes 

Classes have an 8 byte descriptor which is initialized at run 
time. The first word of the descriptor points to the first free 
location in the area reserved for the class. The second word points 
to the first location after the class. The code generated for ALLOC 
tests if all the space for the class has been used, and if so, a 
null pointer is returned; otherwise, a pointer to the allocated 
record is returned. 
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FDT0BE_WORK 

In order to expedite the actual bootstrapping of the compiler, 
the development and testing of many features was deferred. Also, 
some non-critical bugs were found, (Non-critical in the sense that 
bootstrapping was not affected) , These features and bugs range from 
items which are very important for the practical use of the 
compiler, to items which can only be considered as •bells and 
whistles*. & list of the known problems follows, in approximately 
their order of importance. In some cases, hints have been given as 
to potential solutions. 

1. The I/O routines need improvement. Better checking of DCB 
parameters on the DD statement should be done, and similar 
sections of the I/O routines should be feorabined. If the user 
forgets the period at the end of a program, or makes some 
other mistake which causes the compiler to read past the end 
of the input text, the compiler ABENDS. An EODAD exit should 
be defined for all input files, and the EOF feature, not 
currently used, should be added. Also, CLOSES ar« now done 
implicitly by the operating system; explicit CLOSES should be 
done whan leaving the scope of a declared file. 



KU^% cd-i e/wiS^ ^ (.w/^i>V W^ 



2. The monitor also needs improvement. The monitor should be 
able to trap program checks and' ABISDs and format a simple 
message, instead of just creating a dump. This is especially 
true for common problems like using a NIL pointer, running 
out of stack space, or dividing ty zero. 

3. The compiler should keep a count of the syntax errors, and 
print a message at the end of compilation, A return code 
should be returned to OS; Any line that is in error should 
be printed, even if the listing has been turned off. 






it. Heal arithmetic needs to be debugged. There are known 
problems in the, comparison code for real numbers, when 
automatic fixed-to-float conversions are required. This 
arises because there are two stacks, and moving an item from 
one stack to the other potentially changes the relative order 
of the operands; consider, for instance, the expression 
(KX) , with I integer, X real. Perhaps automatic conversions 
should be provided only for assignments; other coercions 
would have to be made explicitly. 

5. A means to link to the routines in the FOBTBAN library should 
be implemented. A scheme similar to ALGOLW might be 
possible, and then common functions (SQBT, SIN, et:c,) would 
be predefined to be FOSTBAN type. Since real OS object 
modules are generated, this modification would greatly extend 
the capabilities of the compiler. To do this requires that 
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^ the FORTEAN I/O package (ESBMON, etc.) be bypassed somehow. 

H 6. Powersets currently do not work. The contexttable entries 

are set up, but the wrong code is generated. 

g| 7, Boolean expressions and jumps generate extremely inefficient 

^ code., since a true or false value is always generated. Some 

arithmetic operations generate condition codes themselves; 
A the LCOND variant of the ATTfi records nay be used to record 

^ this information, and some jump sequences would be shorter. 

This iaproveaient would help FOB, HHILE, and REPEAT 
|b statements, as well as IF-THEN-ELSE statements. 

8, Routines to BEAD an item, WRITE an item, and to convert from 
1^ floating to fixed should be written. Currently, users are 

^ required to format their output, and decode their input, by 

writing the proper routines in PASCAL. 

^ 9. Preliminary tests with PROGLOOK indicate that about 44 per 

cent of the time spent in the PASCAI compiler is used in 

g| searching the symbol table. Some form of hashing would be a 

great help, but probable difficult to fit into the general 
contexttable organization. 

10. INSYMBOL has an inaccurate algorithm for building up the 
value of a real number. It should be made smarter. 

11. Array addressing uses shifts to calculate some element 
addresses. In some cases, it would require less code, but 

g| more tine, to use a MH instruction. The tradeoffs should be 

^ examined to determine which method is better. 

m 12. Using shifts in TERM for multiplication by certain constants 

^ (also divide, DIV, and HOD) should be considered. 

H 13. All fixed-point multiplication and division is now done by 

~ using SO-81 as the double length pair. Since the registers 

are used in decresing order, some of the time a lead of 10 or 
g| R1 could be avoided, 

14. Keep some addresses in the registers. An address stack (in 
^ the general purpose registers) may be defined which occupies 

^ the same space as, but grows in a direction opposite to, the 

expression stack. Addresses and 4K constants may be put in 
H these registers. As long as a branch is not made which 

invalidates these addresses, they may be used in later 
instructions. A descriptor (as yet undefined) for these" 
quantities may reside in array ASfK. This address mechanism 
needs to be developed (or redesigned). Avoiding repeated 
loads of the same base addresses or 4K constants is expected 
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to have a very beneficial effect on the WITH construct, and " 

on soiae array accessing. 

15, Multiple errors at the same input position are marked only ^ 
once in the listing. If errors occur at two or more 

different points in the input line, and more error numbers ^ 

are listed than errors are marked, then it is difficult to ^ 

know which marks go with which errors, 

16. Procedures and functions as parameters need to be ^ 
implemented. 



17. Obiect decks currently have only one ESD or one BID entry per 
card; this should be fixed. fhe deck should also be 
sequence numbered, 

18. Nested function calls are allowed, but may run out of 
registers if the complexity is too great. This restriction 
could be eliminated, or made optional. 

+ 

19. Parameter lists are limited to 4K in length. 

20. Currently, a stack type machine is simulated. All operations 
are done between operands in the registers. It should be 
possible to use BX type instructions in some cases to reduce 
the size of the generated code. 

21. {Single) character files are not currently implemented. 

22. Some arrays may be directly addressable, while others are 
assigned addresses with a displacement into the data area of 
more than UK, It might be possible to decide at compile-time 
which arrays should be directly addressable, (on the basis, 
say, of frequency of access) , and assign the actual location 
of the arrays accordingly, 

23. ALFA types should be removed and replaced by aBE&Y OF CHAfi. 
A generalized MOVE built-in procedure could replace the 

, ONPACK and PACK procedures, if desired, 

24. The concept of CLASS could be removed, as in the revised 
PASCAL language. This might require considerable run-time 
support and major changes to the compiler, 

25. Records of a class are allocated the minimum amount of 
storage necessary, depending on the variants specified. 
Because of this, assignment of one record to another is not 
always valid, even if they are ostensible the same type, 
unless the length of the source is less than the length of 
the destination, Secords which are not allocated from a 
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class can be assigned to each other (if they are the same 
type) , since they are always allocated the roaxintuiB space of 
any variant, 

Hecord comparisons are dangerous because unpacked records can 
have gaps due to alignment which may contain trash at run 
time. It is probably best to just disallow such assignments 
and comparisons. 

26. The compiler options which generate code to perform run-time 
index checking, overflow checking, etc, have not been 
implemented. This would necessitate changes in the monitor 
as well. 
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APPENDIX ft. Compiler OTJtions 

Compiler options may be specified by placing option switches 
inside a comment. The first character of the comment must be '$», 
followed by a sequence of option switches, separated by commas. 
Each option switch takes the form ftx, where ft is a given option that 
is turned on if x=*+* and turned off otherwise. 

There are currently only three options that are implemented. L 

controls listing of the source text, P controls printing of the 

compiled machine code and constants at the end of a procedure, and C 

controls printing of compiled code during its actual generation 

(f ixups will not have been made) . 

Thus, for example, the option string "$1-^E<-" would turn off 
the source listing but print the generated code for the remaining 
procedures. 

The default value for L is to produce a listing; the default 
value for P and C is not to print the generated instructions. 
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ftPPENDIX B., Samjple, grogj:am,^and_,coinpiler output 

A sample program is given below, along with the JCL necessary 
to ran it on the system at SLAC. The exact JCL used at a particular 
installation will of course vary, but this example can act as a 
model, although this job uses the linkage editor, the loader could 
also have been used. 



// JOB ,CLASS=E 

//PASCAL EXEC PGfl=PASCAL 

//STEPLIB DD DSN=WYL.SF.PAS.PA$CALJB,DISP=SHfi 

//SYSPBINT DD SISOOT=A, 

// DCB* (REC^H=FBA,LaECL=121,BLKSIZE=ia52,BOFNO=2) 

//SYSODUHP DD SYSODT=A 

//PASCALGO DD DSH=5L0ADSET,SPACE= (TBK, (5, 1) , BLSE) ,ONIT=SYSDA, 

// DISP=(,PASS) ,DCB={BLKSIZE-400,RECFH=FB,LEECL=80) 

//SYSIN DD * 

TYPE XX=ABBAY(1..8)0F INTEGEB; 

VAH A: XX; 

SYSPaiNT:FlLE OF ABRAY (0. . 120) OF CflAB; 
SYSINtFILE OF AaHAy{0..79) OF CHAB; 
I,J:I19T1GEB; 
PBOCEDOBE CLEAE; 
VAR IlINTEGER; 
BEGIN 

FOE I:=0 TO 120 DO SYSPBINT (!):=» »; 
END "CLEAH"; 
n$P4-" 
PBOCED0BE PBINT (7AL, PLACE: ISTEGEl) ; 
VAB I,J:INTEGEE; 
BEGIN I:=VAL; J:=fLACE; 
EEPEAT 

SYSPBINT (J) :-CHE(240+(I MOD 10) ) ; 
I:=I DIV 10; 
J:=J-1; 
ONTIL I<=0; 
END «»P1INT"; 
"$P-" 
PEOCEDDBE PRINTC(A:XX; N:INfEGER) ; 
BEGIN 

PEINTCA(N) ,N*a) ; 
END "PBINTC"; 
BEGIN "PASCAL TIIANGLE" 
GET (SYSIN); 
CLEAE; 

FOB I:=0 TO 79 DO SYSPBINT CI) :=SYSIN (I) ; 
POT (SYSPBINT) ; 
FOE I:=1 TO 8 DO 

BEGIN IF 1=1 THEN AC1)t=1 ELSE A(I):=0; 



m 
m 
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CLEfiB; 

FOR J:=I DOWNTO 2 Db 

a(J): = A(J)+A(J-1) ; 
FOR J:=1 TO I DO 

PRINTC(A,J); 
POT(SYSPRINT) ; 
END; 



EKD, 
//IKED 
//SYSLIB 
//SySLIN 

// 

//SYSLMOD 

// 

//SYSPRINT 

// 

//SYS0T1 
//GO EXEC 
//SYSPSIHT DD 

// 

//SY5UDUMP DD 

//SYS IN DD 

HELLO GEORGE 



EXEC 
DD 
DD 

DD 



DD 



DD 



PGa=IEWL,REGI0N=150K,TIME= (,30) ,PARH-»LET»LIST, HAP» 

DSN=HYL.SF.PAS.PSCLLIB,DISP=SHB 

DSN=SSLOADSET,ONIT=SYSDA,DISP= (HOD, DELETE, DELETE) , 

SPACE=CTHK, (0)) 

DSli=S5G0SET(MAIN) ,UNIT=SYSDA,DISP= (KE8, PASS, DELETE) , 

SPACE=CTRK, (100,20,1) ,RLSE,,fiO0!JD) 

S¥SO0T=A,DCB=CRECFM=FBB,LRECL=121,BLKSIZE=1573) , 

SPACE=(CYL, (1,1), ELSE) 

ONIT=SYSDA,SPACE=(TBK, (100,20)) 

PG«=*.LKE0.SYSLMOD,REGIQN=150K,COND=(5,LT,LKED) . 

SYSOOT=A, 

DCB= (HECF«=FBA,BLKSIZE=1452,LSECL=121,BUFSO=2) 

SYSO0T=A 

.*■■,■ 



The compiler output for this progran appears below; 



000000 
00007C 
00009C 
000125 
000188 
000190 
000000 
OOOOUC 
0000«*0 
000070 

ooooati 

000084 
000084 
000058 
000050 
000050 
000076 
00008C 
000096 
OOOOAC 



TYPE XX*ABRAY(1..8)CF INTEGER; 
YAB A:XX; 

SYSPRINT:FILE Of ARRAY (0. . 120) OP CHAR; 
SYSIS:FILE OF ARRAY (0.. 79) OF CHAR; 
I,J:INfTEGER; 
PROCEDURE CLEAR; 
V&R I:INTEGER; 
BEGIN 

FOR I:=0 TO 120 DO SYSPRINT 
EHD "CLEAR"; 
»«$p+« 

PROCEDURE PRIST (VAL, PLACE: INTEGER) ; 
?AE I,J:INT1GEE; 



• 
• 
• 



(I):=» •; 



BEGIN I:=?AL; 
REPEAT 

SYSPRINT 
I:=I DI? 
J:=J-1; 
UNTIL I<=0; 
BSD "PlINT"; 



J:=PLACE; 

(J) ;=CHB (240+ (I HOD 
10; 



10)) 
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CONSTANTS 








OOOOCO 


DC X' 


00 00 


00 00* 


000000 





BC 


15, 20 ( 0, 15) 


oooon 


20 


STH 


14, J2, 12( 13) 


000018 


24 


LB 


3, 15 


00001A 


26 


LA 


4, 4095 ( 0, 3) 


00001E 


30 


LA 


4, 1(0, 4) 


000022 


34 


ST 


13, 4( 0, 2) 


000026 


38 


ST 


2, 8(0, 13) 


00002ft 


42 


LB 


13, 2 


00002C 


44 


A 


2, 16( 0, 3) 


000030 


48 


C 


2, 80 ( 0, 12) 


00003ft 


52 


BC 


12, 64 ( 0, 3) • 


000038 


56 


S8 


1, 1 


0000311 


58 


L 


15, 192 ( 0, 3) 


00003E 


62 


Bca 


15, 15 


000040 


64 


L 


11, 72( 0, 13) 


OOOOitft 


68 


ST 


11, 80 ( 0, 13) 


OOOOttS 


72 


L 


11, 76 ( 0, 13) 


00004C 


76 


ST 


11, 84( 0, 13) 


000050 


80 


L 


11, 156 ( 0, 12) 


OOOOSft 


84 


L 


10,' 84 ( 0, 13) 


000058 


88 


AS 


11, 10 


00005A 


90 


LA 


10, 240 ( 0, 0) 


00005E 


94 


L 


9, 80{ 0, 13) 


000062 


98 


LA 


8, 10( 0, 0) 


000066 


102 


LR 


0, 9 


000068 


104 


SSDA 


0, 0, 32 ( 0) 


00006C 


108 


DE 


0, 8 


00006E 


110 


LB 


9, 


000070 


112 


AB 


10, 9 


000072 


114 


STC 


10, 0( 0, 11) 


000076 


118 


L 


11, 80 ( 0, 13) 


00007A 


122 


LA 


10, 10( 0, 0) 


00007E 


126 


LB 


0, 11 


000080 


128 


SBDA 


0, 0,. 32 ( 0) 


00008U 


132 


DB 


0", 10 


000086 


134 


LB 


11, 1 


000088 


136 


ST 


11, 80( 0, 13) 


00008C 


140 


L 


11, 84 C 0, 13) 


000090 


144 


BCTB 


11, 


000092 


145 


ST 


11, 84 ( 0, 13) 


000096 


150 


L 


11, 80 ( 0, 13) 


00009A 


154 


LTH 


11, 11 


00009C 


156 


LA 


11, 1(0, 0) 


OOOO&O 


160 


BC 


12, 166 ( 0, 3) 


000044 


164 


SI 


11, 11 


0000A6 


166 


LTB 


11, 11 


0000 A 8 


188 


BC 


8, 801 0, 3) 



21 



OOOOAC 
OOOOBO 
0000B4 
0000B8 
0000C4 
0000C4 
0000C4 

ooooao 

000078 
000092 
OOOOAB 
0000B2 
OOOOBC 
OOOOFA 
OOOIOt* 
000116 
00014A 
000154 
000166 
000196 
0001AC 
0001D8 
0001B2 
0001F0 



172 
176 
180 
184 



L 

LH 
MVI 
BCR 



13, H( 0, 13) 

14, 12, 12 ( 13) 
12( 13) , 255 

15, 14 



PIOCEDOSE PSIHTC(a:XX; NjINTEGEB); 
BEGIN 

PRINT (A (N) ,N*4) ; 
END "PRINTC; 
BEGIN "PASCAL IBIANGLE'' 
GET(SYSIN): 
CLEA5; 

FOB I:=0 TO 79 DC SYSPBINT (I) : = SYSIS (I) ; 
PUT(SYSPRIST) ; ' 
FOB I:=1 TO 8 DO ' 

BEGIN IF 1=1 THEN AC1): = 1 EISE A(I):=0: 
CLEAS; 

FOR J:=I DCUNTO 2 DO 
A{J):=A(J) ♦A(J-I) ; 
FOR J:=1 TO I DO 

PaiNTC(A,J>; 
POT(SYSPaiNT) ; 
END; 
END. 



• 



The linkage editor output is; 



F64-LEVEL LINKAGE EDITOR OPTIONS SPECIFIED LET, LIST, HAP 
DEFADLT OPTION (S> USED- SI2E= (307200,6 1440) 
lEWOOOO INCLUDE SYSLIB (PSCLMON) 
lEWOOOO ENTRY PSCLHON 



CONTROL SECTION 



NAHE 


ORIGIN 


LENGTH 


C1EAR$$ 


00 


84 


PHINT$$ 


88 


C4 


PBINTC$ 


150 


92 


$$$MAIN 


1E8 


23C 


PSCLHON 


428 


CE 


PSCLGETB* 


4F8 


124 


PSCLPUTH* 


620 


12C 





HODULE 


MAP 


ENTBY 






NAME 


LOCATION 


NA 



PSCIEEE 



4C6 



• 
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ENTRY ADDRESS 428 

TOTAL LENGTH 750 
♦♦♦♦MAIN DOES NOT EXIST BUT HAS BEEN ADDED TO DATA SET 
AUTHORIZATION CODE IS 0. 



The output from the execution of this job is: 



HELLO GEORGE 



1 1 












1 2 


1 










1 3 


3 


1 








1 4 


6 


4 


1 






1 5 


10 


10 


5 


1 




1 6 


15 


20 


15 


6 


1 


1 7 


21 


35 


35 


21 


7 
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AE£INDIX_Ci Se£arate_coBgilation qf .global _ procedures 



# 

m 
m 






m 
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apPENDIX_Dj5 Dg gc ri£tion . of distributipn^tagg 



PBOJECT HISTOHY 2 

LANGUAGE DIFPEEENCES 3 

IHPLEMENTATION DETAILS H 

Monitor 4 

Buntime environment and register assignment 5 

Procedure entry and exit 5 

Data objects 6 

Data addressing ,7 

Constants 7 

External names and label processing 8 

Global data 8 

Input/output 9 

Procedure and function calls 10 

Classes 10 

FOTURE WORK 11 

ACKNOWLEDGEMENTS 15 

SEFEBENCES 16 

APPENDIX A. Compiler options 17 

APPENDIX B. Saople prograai and compiler output 18 

APPENDIX C. Separate conpilation of global procedures 23 

APPENDIX D. Description of distribution tape 24 



T*«lk 



■'% 4 





1. 

2. 




3. 




5. 




5. 


# 


7. 




9. 


• 


10. 
U. 




12. 


• 


13. 
14. 


i 


15. 


jdk 


16. 
17. 




18. 




19. 

20. 




21. 




22. 
23. 




24. 




25. 
26. 


! 


27. 


flip 
i 


28. 
29. 




30. 


1 


31. 
32. 




33. 





34. 
35. 




36. 




37. 
38. 


1 


39. 


• 
— 1 


40. 
41. 




42. 




43. 
44. 




45. 




46. 
47. 




48. 




49. 

50. 




51. 


" 


52. 
53. 




54. 




55. 
56. 




57. 




58. 
59. 


k 





* * 

* PASCAL Compiler * 

* * 

* ( JANUARY 1972 ) * 

* * 

* AUTHORS: U. AMMANN, R. SCHILD. * 

* * 

* FACHGRUPPE COMPUTERWISSENSCHAFTEN * 

* EIDG. TECHNISCHE HOCHSCHULE * 

* CH-8006 ZUERICH * 

* * 

* * 

* Wn 360 VERSION SEPTEMBER 1974 * 

* * 

* AUTHORS: 0. RUSSEl-L* J. SUE, R. LEE, * 

* R. WILHELM * 

* « 

* COMPUTER SCIENCE DEPARTHENT * 

* STANFORD UNIVERSITY * 
« STANFORD, CALIFORNIA 94305 * 

4: # « }$; jjc ]^ 3$: !{e 3k <c ^ # « ]^ # ije :4c 4: 4c 3ic Jjc :9c sjc :<( # 4e $ 3^ 4: 4i 4: i4c ^ 4( # « ^ ;^ :^ ]|c 9t( :<( % lie 3(c ^ 



CONST MAXIO = 2147483647f MAXHALF = 32767, TM0T012 « 4096, 
NAXISTK = 7, MAXRSTK = 4, MAXBASEREG = 2» 
MAXLA8S = 30, !«IAXEXLABS = 15, CASMAX = 30, 
CSTMAX =40, CODMAX =8191, 

OISPLm = 20, MAXLEVEL = lOt PTLIHIT = 10, FILLIMIT = 10, 
OlSPLIMIT = 4095, WOROLENGTH = 32, AlFALENG = 10, 
JMPMAX = 49, UNDMAX = 70f 

l!4PT = 84; OUTPT = 1O4; "ADORE SSgS OF FC8S FOR iNPuT,OutPuT" 

GLOBALREG = 12f LOCALREG = 13; 

TYPE CTP * aCONTgXTTASLE; 

CHORD = ARRAY il..lOi OF CHAR; 
pRIMTlInE = ARRAY(0.»120) OF CHAR; 
CARDIMAGE = ARRAY(1..80V OF CHAR; 
ADDRESS = -. 16777216; 
SHRTINT = -MAXHALF ,. MAXHALF; 
8ITRANGE = ,. 30; RG3 = .. MAXLEVEL? 
BYTE = 0..255; 

ATTRKIMD = (VAR8L,SVAL,LVAL,LC0NDl; 
ATTR = RECORD TYPTR : CTP ; 
CASE KIND 
VARBL: 



SVAL: 
LVAl: 

LCOND 



: ATTRKIND OF 

(ACCESS : CBRCT,INORCT,INXDJ ; 
BREG:RG3 ; DPLMT: ADDRESS; ALIGNMeNt:SHRTI NT ; 
CASE PCKD : BOOLEAN OF 
FALSf: ; 

TRUE: (BItaOr, bITSZ : 8ITRANGEU 5 
IvAl : SHRTiNT) ? 

jCjErm : Integer* ; 

iJMP : ,. 3 ; ARlTH : BOOLeaNj 



END 



ftilHlUlillMHWliMi—BIWHi 



6D, "0ESCRI3ES EXPf^ESSIONS TO BE CQMPIt.ED. EXAMPLES: 

61. VARBL: DRCT: I ** > 

52. INDRCT: INPUTS *l 

63. INXO: AlKJ *) 

64. SVAL: 4 **l 

65. LVAL: 2*1 - I *) 

66. LCQNO: ARITH: X >= 4.1 *} 

67. -.ARITH: B < True *j 
68. 

69. *l RESULT OF CODEGENERATION IN REGISTER X-Rp 

70. **) NO Code generation until now 

71. 
72. 

73. optpwr = (N0DPT,PUREP,P0SP,NEGP) ; 

74. IOCLASS = {TYPES, KONST,PROCfVARS, FIELD, TAGFIELOfDUMMfCLASSl; 

75. TYPFORM = ( NUMERIC, SYMBOLIG, POINTER, POWER, 

76. ARRAYS, RECORDS, CLASSS, FILES) ? 

77. IDKINOS = CACTUAL, FORMAL) ; 

78. WHERE = {BLOCK, CWITH,VWITH); 

79. CONJSTKIND = (INTEGERS, REALS, ALFAS, CHARS, SYMBOLICS, EXTREF) i 
30. CONSTANT = "PACKED" RECORD CASE KONSTKINO : CONSTKIND OF 

81. INTEGERS : CHARS : SYMBOLICS : {I VALUE : INTEGER); 

82. REALS : {RVALUE I REAL); 

83. AlFaS : {AVALUe l ALFA); 

84. ExTREJ^ : (EVALUE I ALFA); 

85. END; 
86. 

37. VAR 

83. ONE, TEN, TENTH : REAL} "CONSTANTS FOR INSYMBOL" 

89. ISTKLIM : SHRTINT; NILVAL : CONSTANT; 

90. JMPTA8 : ARRAY {O..JMPMAX) OF INTEGER; 

91. JMPIX : SHRTINT; 

92. "TRANiSFER VECTOR FOR CALLS OF FORWARD DECLARED PROCEDURES AND 

93. GOTO STATEMENTS LEADING OUT OF PROCEDURES" 
94. 

95. PILEV,FILEV ; ARRAY { O..MAXLEVEL ) OF SHRTINT; 

96. PFL,PEND : ARRAY{ O..FILLIMIT) OF ADDRESS; 

97. PILPTS : ARRAY ( 0. .FILLIMIT) OF CTP; 

98. XFILPT : CTP; 

99. PFTOP,FILTOP : SHRTINT; 

100. "PFL CONTAINS THE ADDRESSES OE LOCAL CLASSES, 

101. PILEV CONTAINS POINTERS INTO PFL AND PEND, PFTOP = TOP OF PFL, 

102. FILPTS CONTAINS POINTERS TO ENTRIES Eqr LOCAL FILES, 

103- FRFV CONTAINS POINTERS I NtO FlLPfS, FlLfO^ = TOP 0^ ^iLPTS" 

104. 

105. EXTAB : ARRAY { 1. .MAXEXLA8S) OF 

106. RECORD EXVAL,EXLEVeL : SHRTINt; EXT^AME : AlFA EnD; 

107. CEXTABIX : SHRTINT; 
lOS. FSTIXG : SHRTINT; 

109. "CONTAINS THE EXPLICITLY DECLARED LABELS OF ALL PROCEDURES 

110. MOT YET CLOSED, TOGETHER WITH THEIR CORRESPONDING INDEX 

111. INTO JMPTAB" 
112. 

lial LA8TA8 : ARRAY C I..MAXLA8S) OF 

114. "PACKED" RECORD LABVAL,LABLOC, CHAIN : SHRTINT ENO; 

115. CLA8IX : SHRTINT; 

116. "CONTAINS ALL LABELS MET SO FAR IN THE BODY OF THE PROCEDURE 

117. ACTUALLY BEING COMPILED, TOGETHER WITH INFORMATION WHETHER 

118. LABEL OEFINITION {<LA8EL>:) ALREADY FOUND OR NOT (FLD2). 

119. IN THE FORMER CASE FLD3 CONTAINS THE CORRESPONDING ADDRESS, 



• 
• 

• 
# 






• 



120* 
121. 
122. 
123. 
124^. 
125. 
126. 
127. 
128. 
129. 
130. 
131. 
132. 
133. 
134, 

135. 
136. 
137. 
138. 
139. 
140. 
141. 
142. 
143. 
144. 
145. 
146. 
147. 
148. 
149, 
150- 
151. 
152. 
153. 
154. 
155. 
156. 
157. 
158. 
159. 
160. 
161. 
162. 
163. 
164. 
165. 
166. 
167. 
168. 
169. 
170. 

171. 
172. 
173. 

174. 
175. 
176. 
177. 
178. 
179. 



WHERE IN THE LATTER CASE FL03 CONTAINS 
WHERE THE OCCURRENCES ARE CHAINED" 



AN INDEX INTO UNOLAB 






UNOLAB : ARRAY (1..UN0MAX} OF 
"PACKED" RECORD SUCCt PLACE : 
LFTSH : BITRANGE ; 
EMD ; 
CH?^IX : SHRTINT; 

"ACTS AS LISTSTRUCTURE, CHAINING 
JUMPS TO NOT VET REACHED LABELS 
ACTUALLY BEING COMPILED. 
CHNIX = HEAD OF FREE LIST" 



SHRTINT 



OCCURRENCES 
IN THE CODE 



OF CONSTANTS AND 

OF THE PROCEDURE 



..PTLlMlTl OF 
ALFA; PPTR : CTP 



PTLIST : ARRAY (0. 

RECORD HNAME : ALFA; PPTR : CTP END; 
PTX : SHRTINT; 

"PTLIST CONTAINS NAMES OF YET UNDECLARED CLASSES AnO 
POINTERS TO THE CORRESPONDING POINTER-TYPE ENTRIES 
PTX = TOP OF PTLIST " 

ERRLIST : ARRAY (I-.IO) OF 

"PACKED" RECORD POS,NMR : SHRTINT END; 
ERRNRS : ARRAY C0..5> OF POWERSET 0..30 ; 

eRRINX,POSl,CHCNT : SHRTINT; EQLFLAG, ERR, COMPILING : BOOLEAN; 
CHPTRXfPTOUT : SHRTINT; 
"ERRLIST CONTAINS THE POSITIONS ANO NUMBERS OF THE ERRORS 

ON ONE LINE 

ERRINX = TOP OF ERRLIST 

POSl = POSITION OF LAST PRINTED ERRORMARK ( a ) 

CHCNT = POSITION OF LAST READ CHARACTER 
ERRLIST, ERRINXfPOSlfCHCNTfEOLFLAG ARE USED BY NEXTCH 

And ERROR. 
ERR IS SET WHENEVER ERROR HAS BEEN CALLED AND IS TESTED 

{AND RESET) BY SEVERAL PROCEDURES " 

DISPLAY : ARRAY rO--DlSPtIMI OF 
"PACKED" RECORD FNAME : CTp; 
CASE OCCUR : WHERE OF 

SLOCK : ; 

CWITH : ICDSPL 

VWITH : (VDSPL 

end; 

TOP,DISX : SHRTINT; 

"TOP = TOP OF DISPLAY, DISX IS RETURNED BY SEARCH" 



i # 



• 



ADDRESS; CLEV 
ADDRESS); 



R63 ) ; 



CA : SHRTINT; 

LCIC : ADDRESS; 
"LOCATION COUNTER 



• 



And INSTRUCTION COUNTER" 



LEVEL, RP»RP1,RRP : SHRTINT; 

"RP,RPl = REGISTER-POINTERS (STACK OF X-REGS)" 

OP,ENDFLAG : BOOLEAN ; 

"DP = TRUE : DECLARATION PART (USED BY NEXTCH)" 

"ENDFLAG : TO TEST FOR END. " 

PRC0DE,ASSCHECK,INXCHECK,01VCHECK,ST0FLCHECK, 
TRACECHECK,PCODE, LISTING : BOOLEAN ; "COMPILER OPTIONS" 
VDATA : BOOLEAN ; "SET TRUE IF VALUE INITIALIZATIONS" 
ASSERR: SHRTINT; 





180. 


HI 


181. 
182. 




183. 




135. 




186. 




187. 
188. 




189. 


A 


190. 
191. 
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193. 
194. 




195. 




196. 
197. 




198. 


^^ 


199. 
200. 




201. 
202. 

203. 




204. 




205. 
206. 


1 


207. 




208. 
209. 


i 


210. 


^B 


211. 
212- 




213. 




214. 
215. 
216. 




217. 
218. 




219. 




220. 
221. 




222. 




223. 

224. 




225. 




226. 
227. 




, 228. 


1^ 


229. 
230. 




231. 




232. 
233. 
234. 




235. 

23 fc. 




237. 




238. 
239. 


• 





GL0BALN4ME,UNIQUENAME : ALFA; 

SATTR : ATTR ; '•GLOBAL ATTRIBUTE RECORD " 

SSaDDR : RECORD B2fD2 : SHRTINj EnD; 
RXAODR : RECORD B2,D2,X2 : SHRTINT END; 

IMTPTRtREALPTRtALFAPTR,CHARPTR»800LPTR,NUPTR, 

UNDECPTR,PNUMPTR,EXTPTR,LAMPTR : CTP; "CONSTANT POINTERS" 

NEXTtCTPTR : CTP; 

"VARIABLES POINTING INTO CONTEXTTABLE" 

CH,CHVAL : CHAR; AVAL : ALFA; IVAL : INTEGER; RVAL : REAL; 
A ; CWORD; 
NOtCL : SHRTINT; 

"CH IS OUTPUT Qf NEXTCH AND USED BY INSYMBOL. 
AVAL /IVAL, NOf CL ARE OUTPUT By iNSYMBot" 

TCT/TMAX,B6DPL»KK : ADDRESS ; 
PT I Ctp; IT,ITI : INTEGER; 

"Auxiliary variables, used in main pgm and Several procedures" 



"CONSTANTS AND CONSTANT TABLES^ " 

SPLITSTAT : ARRAY CO.. 48) OF SHRTINT; 

ERRCLfTERRCL : ARRAY <0..48) OF 11 RRELSy,S£GSY,ENOSY) ; 

BLANK, BLANKALFA : ALFA; 

BLANKLINE i PRINTLINE; BLANKCARO : CAROIMAGE; 

WD : ARRAY t0..33) OF ALFA; 

WNOfWCL : ARRAY {0.-33) OF SHRTINT; 

\4L : ARRAY (0..11) OF SHRTINT; 

" WO = I^ORO DELIMITERS 
W^iOtWCL = CORRESPONDING VALUES OF NO AND CL 
WORD DELIMITERS OF LENGTH I START IN WOCWLUH »» 

CHARTYPEf SYMNO,sYMCl : ARRAy (CHar) 0^ BYTE? 

"NO AND CL" OF EACH CHARACTER" 

MNEM . ARRAy(o..255) qP ArraY{0..3) OF CHAR; 

INITNAM ; ARRAy <-l-.30) oF ALFA; 

"CONTAINS THE PREDEFINED IDENTIFIERS, 

usEo fq!? Initializing the context table" 

8ASEREGN0, BASE : SHRTINT ; 

BASEREG : ARRAYU.-MAXBASEREG5 OF SHRTINT; 

STK : ARRAYU..MAXISTK) OF SHRTiNT; 

RSTK : ARRAYCl.-MAXRSTKI OF SHRTINT; 

ASTK : ARRAYiO-.MAXISTKl OF INTEGER; 

MASKARRAY : ARRAY! I. .7) OF SHRTINT; 

UNIQINDEX : SHRTINT; 

UNIOCH I ARRAY<0..54| OF CHAR; 

HEXCHAR: ARRAY{0..15J OF CHAR; 

SYSPRINT : FILE OF PRINTLINE; 

SYSI^ : FILE OF CAROIMAGE; 

PAsCALGOCOuTl : PIlE 0^ CArDImaGE; 

CSTTB : ArrAy (1..CSTMAX) OF 

RECORD VaLU j CONSTaNt; INx»CNExT : SH^Tl^T En^; 
FLCX,HlCX,AlCX,RLCX,€lCX j shrtInt; 

"CONTAINS ALL CONSTANTS C OCCURRING IN THE 
PROCEDURE ACTUALLY BEING CQMPIlEO TOGETHER WITH AN INDEX INTO 
UNDLAB WHERE THEIR OCCURRENCES IN THE CODE OF THIS PROCEDURE 
ARE CHAINED" 



• 






! • 
I 

! 

I 

I • 

! 
1 



• 



240, 

241, CODE : ARRAY {O..CODMAX) OF BYTE; 

242, 

243, CONTEXTTABLE : CLASS 550 OF 

244, "PACKEO" RECORD 

245, NAME : ALFA; NXTEL : CTP; ALIGN : SHRTINT; 

246, CASE KLASS : IDCLASS OF 

247, TYPES : (SIZE : INTEGER; 

248, CASE FORM : TYPFORM OF 

249, NUMERIC : (BITS : BiTRANGE; MINtMAX : INTEGER}; 

250, SYMBOLIC : ( FCONST, pVlSj: T : CTP; BITSIZE : BIT^AnGEI; 

251, POINTER : ( DOHA IN,ELTYPE : CTP); 

252, POWER : (ELSET : CTp; PWBITS : BITRANGEl; 

253, ARRAYS i I AELTYPE, I NXTYPE : CTP; LOfHI : INTEGER; 

254, OPTTYP : OPTPWR; EXP1,EXP2 : BITRANGEl; 

255, RECORDS : ( FSTFLD,REC VAR : CTP); 

256, CLASSS : IPELTYPE : CTP); 

257, FILES : I FELTYPE : CTPJ ); 

258, KONST : tCONTYPE ? CTP; 

259, CASE CDISIKINO I lOKINDS OF 

260, ACTUAL : ( SUCC : CTP; VALUES : CONSTANT); 

261, FORMAL : (CAODR : ADDRESS; CLEVEL : RG3) ); 

262, PROC : CPROCTYPE»FORMALS,SURRPROC : CTP; 

263, PROCKIND : IDKINOS; 

264, PRoCADDr : AODrEsS; PROCLEVEL : RG3; 

265, SEGsUE ; sHrtInT; SONAME : ALFA; 

266, PREOEF : BOOLEAN); 

267, VARS : (VTYPE : CTP; VKINO : IDKINDS; 

268, VADOR : AOOresS; VLEVEL : RG3; SSIZE: INTEGER "AOORESS") 

269, FIELD : {FLDTYPE : CTP; FLOADDR : ADDRESS; 

270, BITDlSPLfBITWIDTH i BITRANGE); 

271, TAGFIELD : CCASESIZE : SHRTINT; VARIANTS : CTP; 

272, CASE TAGVAL : BOOLEAN OF 

273, FALSE 5 CCASETYPE : CTP); 

274, TRUE : (CASEVAL : SHRTINT) ); 

275, END; 
276. 

277. « VARIABLE INITIALIZATIONS « 

278. VALUE 

279. SPLITSTAT = « 1,2, 19*1 ,3, 1,4, I, 1,5,1 ,6»l ,7,1 ,8,2*1 ,9,12*1, 10) ; 

280. ERRGL = t l6*IRRELSY,ENDSY,4*IRRELSY,BEGSY,ENDSY,8EGSy, IR8ELSY, 

281. EN0SY,3EGSY,IRRELSY,bEGSy,£NDSY»8EGSY*IRRELSY,BEGSY, 

282. 2*lR^ELSY,BEGSY,lRRELSY,ENDSY,2*lRRELSY,2*ENDSy, 

283. IRRELsY»3*EN0SY»2*IRRElSY,BEGsyJ ; 

284. TERRCL = (9*lRRELSY,BEGSY,EN0SY,IRREtSY,eNDSY,3*IRRELSr, 
2S5. ENDSY,IRRELSY,8EGSYf2*IRRELSY,3*ENDSY,2*IRRELSY,EN0SY, 

286, IRRELSY, EN0SY,lRRELSy,EN0SY,IRRELSY,EN0SY,2*IRRELSy, 

287, ENDSY, IRRELSY, EN0SY,BEGSY,IRReLSY»2*ENDSY, IRRELSY, 

288, 3*ENDSY,2*IRRELSY,EnOSY); 

2S9, BLANK = » • ; 8LANKALFA = « •; "MAY NOT WORK" 

290, 8LANKLINE = (12l*» •); 

291. BLANKCARD = {80*» •); 

292, HD = (»IF»,*DO» ,'T0S •OF»,»IN«, 

293. 'END'j'NIL*, »FOR » , 'OI V» , • MOD* , » VAR « , * SET* , 

294, » THEN', ♦ELSE*, *SOTO •, »CASE •, •WITH «, 'TYPE ', «FILE' , 

295. • BEG I N',»UNTIL*,* WHILES 'ARRAYS 'VALUE', 'CLASS', 

296, 'CONST', 'LABELS 

297. 'REPEAT', »DOWNTO', 'RECORD', 'PACKED', 

298. 'FUNCTION', 'POMERSET', 'PROCEDURE') ; 

299, WNO = (23,31,33,27,8, 



• 






300. 


22t36,32,6,6,43,ll, 


301. 


24,25,35t26,48»37,38, 


302, 


21 »29» 30, 38, 47, 38, 4 1, 40, 


303. 


28,33,38,42, 


304. 


44,38,45); 


305. 


WCL = (0,0,1,0,7, 


306. 


0,0,0,4,5,0,0, 


307. 


6*0,3, 


30 8. 


0,0,0,1,0,4,0,0, 


309. 


0,2,2,0, 


310. 


0,5,0); 


311. 


WL = (0,0,0,5,12,19,27,31,31,33,34,34)1 


312. 


CHARTYP6=(75*O,7,5,4*ll,ll*0,3*ll,4,2m,9*O,ll,2*0,6,ll*0f 


313. 


8,3,u,l0,ll,9,65*0»9*lf7*0#9*lf8*0»8*l,6*0,l0*2,6*0); 


314. 


SY^^N3=(75*0,17f8,9.7»7,6,ll*0,6,10,16,5,7,6,9*0,15,2*0,3,ll*0, 


315. 


19, 2, 18, 0, 8, 0,65*0, 9*1, 7*0, 9*1 f8*0»8*lt 6*0, 10*2, 6*01; 


316. 


SyMCL= I 75*0f0* I »0, I, 3, 3, 11*0,1,0,0,1,2,2,9*0,0,2*0,4,11*0, 


317. 


0,1, 0,0, 6, 0,65*0, 9*0, 7*0 #9*0, 8*0*8*0,6*0, 10*1, 6*01; 


318. 


MNEM = {4*» »,«SPM S'BALRS'BCTR*, 


319. 


*8CR «,«SSK S'ISK S'SVC •,2*» •,«SASR»,2*« •,»LPR •,*tNR », 


320. 


•LTR S'LCR •♦•NR »,»CLR S'OR S'XR », 


321. 


H,R S'CR N'AR S'SR »,»MR •, 


322, 


••OR S'ALR •,'SLR • , "LPDR* , »LNDR« , 'LTOR • , 'LCOR « , 'HDR «,«LRDR», 


323. 


•MXR »,'HXDR»,'LOR N'CDR S'AOR »,*SDR ♦,*MOR • , * ODR »,*AWR S'SWR » 


324, 


, •LPER','LNER',»LTER«,«LCER»,«HeR •,»LRER«,»LAXR»f »SXR »,'LeR », 


325. 


'CER S'AER N'SER •,'HER S'DER N'AUR • , • SUR •,«STH S'LA •,'STC ', 


326, 


•IC •,»EX •, «8AL S'BCT •, 


327. 


•8C SaH *,'CH »,»AH »,»SH •,»MH *,'BAS *, 


328- 


'CVD S'CVB N'ST <,3*« S'N •,«CL •♦ 


329. 


»0 «,»X •,«L •,»C '»«A S'S S'M «, 


330, 


•D •,*AL S'SL 'v'STO »,6*« ' t » MXD »i 


331. 


'LO »,'CD *,'AD »,»sd »,«MD •♦ 


332. 


'00 S'AW •,»SW »,»STE t*?*' «, 


333. 


♦IE S'CE «,«AE •,»SE »,*ME *,»0E », 


334. 


•AU •,*SU »,»SSM »,• 't'LPSM*, 


335. 


» ',»WRD »,'R00 S'BXH »,»BXLE», 


336. 


•SRL N'SLL S'SRA 'j^StA » , ♦ SRDL« , • SLDL* , 'SRDA • , »StDA* , » SIM •, 


337. 


«TM «,»*^VI ',«TS *,»NI •,»CLI S'OI •, 


338. 


•XI «, 'LM »,3** ', »SIO •,'TIG • 


339. 


,'HI0 ','TCH ♦,16*« »,*STMC», 'LRA •jS*' •,«LMC »,25*' • 


340. 


,»^VM »,«HVC •,»MVZ «,'NC •,«CLC », 


341. 


•OC ',»XC ',4*» •,«TR »,*TRT ', 


342. 


•ED S •E0MK«,17*» »,»MVO » , 'PAGK' , 'UNPK* ,4* • •,'ZAP «,»CP », 


343, 


'AP •,«$? »,«MP 'j'DP 'jZ*' •); 


344. 


INITNAH = ( •TEXT', »WEOR', 'GET', 'PUT', •RESET*, 'ALLOC*, 


345, 


•PACK', 'UNPACK', 'INSERT', 'APPEND', 


346, 


'READ', 'WRITE', 


347. 


•00D',«IMT',«CHR','EOF ' , 'ABS* » 'SQR' , 


348, 


•TRliNC'PREO', 'SUCC't 'EOL ' , » ALFALENG • , 


349. 


* INPUT »,ioUTpUT 1,1 ALFA »» 'REAL i, «CHARi , iBOQiLEANi , 


350. 


•FALSE', 'TRUE', 'INTEGER'); 


351, 


BASEREG = (3,4); 


352. 


STK = (U,10,<?,8,7,6,5); 


353. 


RSTK = (0,2,4,6); 


354. 


HASKARRAY = C 4, 12, 10, 2,6, 8,0) ; 


355. 


UMIQCH = (».','<',»(',«<-',»€»,'*'♦»)•»';•, 


356, 


»-»','/•,»,*,'«',»_•,'>',•?»,':•♦»#•»• a»»* = *» 


357, 


' 0' , ' 1* , ♦ 2* , • 3» , '4' , *5» , »6« , •7' , »8 » , »9 » , 


358. 


*A',»3»,'C', '0', 'E', »F»,'G','H',»l»,'J','K»,»L*,»M', 


359. 


'N','0','P', »0','R', 'S'.'T', »U»,«V»,»W», 'X ',•¥», 'Z'l; 



• 



3S0. 
36U 
362. 
363. 
364, 
365. 
366. 
367. 
368. 
369. 
370. 
371. 
372, 
373. 
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375. 
376, 
377. 
378. 
379, 
380. 
381. 
382. 
383. 
384. 
385. 
386, 
387, 
388. 
389. 
390. 
391. 
392. 
393. 
394, 
395. 
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399. 
400. 
401. 
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408. 
409, 
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411. 
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414, 
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416, 
417. 
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419. 



HEXCHAR = ('0»,'l',«2't*3«,'4»t*5»,»6N»7»,'8»,«9'»VA», 
»3«,*CSM5S 'ES 'F' ); 

"two stanoaro procedures insert and append are provided for 

Code gemeration- 
append(a,b,c) shifts the contents of a left b bits and 

•or's c imtq it. result in a. b,c unchanged. 
tnsert{a,8,c} shifts the contents of a left b bits and 

•or»s them into c. result in c. atb unchanged 
a,b,c are of type integer " 



PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 

PROCEDURE 
PROCEDURE 

PROCEDURE 
CONST 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 

VAR EXP 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
FUNCTION L 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 



OUTCH(C:CHAR» 1 FORWARD J 

0UTAIF(A : ALFA; WIDTH : SHRTINTJ ; FORWARD ; 

OUTUVAL : INTEGER ; LGTH : SHRTINTI; FORWARD; 

OUTHEXIFVAL : INTEGER ; WIDTH : INTEGER); FORWARD; 

PRTERR ; FORWARD ; 

NEXTCH ; FORWARD ; 

ERRORdiSHRTINT) ; FORWARD ; 

ErRMESSAGEIALF : ALFA ; VAL t ShRTINT) ; FORWARD ; 

INSYMBOL; FORWARD; 

SRCHRECip:CTP>; FORWARD; 

search; FORWARD; 

IMCONST CVAR V : CONSTkino; P : CTP; 

NXT : CTP) ; FORWARD; 

GENJPtFJPADDR : ADDRESS); FORWARD; 

GENRR<0P,R1,R2 : SHRTINT); FORWARD; 

GENRS!0P,Rl,R3,X02fXB2 : SHRTINT); FORWARD; 

GENRX<0PfRl.XD2tXX2tXB2 : SHRTINT); FORWARD; 

GENSIfOP,XDl,XBl,XI2 : SHRTINT); FORWARD; 

GENSS(0PfX01,XL,XBl,X02,XB2 : SHRTINT); FORWARD; 

CHEC<BNDS(FRP,FMINfFMAX,FADR : INTEGER); FORWARD; 

INS(FADR»FCA : ADDRESS); FORWARD; 

MULOPT{VALl:INTEGER; 

1,EXP2: INTEGER; OPTlOPTPWR) ; FORWARD; 

SKlPtFNO : SHRTINT) ; FORWARD; 

PRlNTCilNC : BOOLEAN); FORWARD; 

PRTCOMP; FORWARD; 

PRI5^TCT; J^orward; 

3G2|VALl:INTEGER) : ShrTinT; FORWARD; 

STKERR; FORWARD; 

GEMCONST(FVAL:CONSTANT; FCA: ADDRESS) ; FORWARD; 

LDCST2(FvALsC0NSTANT; FRP:SHRTINT) ; FORWARD; 

LDCST(FVAL:COnSTAnT) ; FORWARD; 

GENADDR{FATTR:ATTR; I:SHRTINT); FORWARD; 

GE!^SA0DR(FATTR:ATTR) ; FORWARD; 

LOADBASECFRP, i : SHRTINT) ; FORWARD; 

LOADtVAR FATTR:ATTR); FORWARD; 

STOREIFATTR:ATTR); FORWARD; 

LOADADRIVAR FATTR:ATTR); FORWARD; 

ADORESSVAR(FCTP : CTP ; VAR FATTR : ATTR) ; FORWARD; 

UPALIGN IVAR OISPLMNTEGER; CONST ALISMUNTEGER); FORWARD; 

VARIABLE; FORWARD; 

FACTOR; FORWARD; 

TERM; FORWARD; 

SIMPLEEXP; FORWARD; 

EXPRESSION; FORWARD; 

PASSPARAMS; FORWARD; 

ASSIGN; FORWARD; 

VARIAB; FORWARD; 

ALLC; FORWARD; 
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420. 
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423. 
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426. 
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431. 
432. 
433. 
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436. 
437. 
43 8. 
439. 
440. 
441- 
442. 
443. 
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445. 

446. 
447. 
448, 
449. 
450. 
451. 
452. 
453. 
454. 
455. 
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457. 
458. 
459. 
460. 
461. 
462. 
463. 
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466. 
46 7. 
468. 
469. 
470. 
471. 
472. 
473. 
474. 
475. 
476. 
477. 
478- 
479. 



PROCEDUR 
PROCEDUR 
PRQCEOUR 
PR(3CE0UR 
PROCEDUR 
PRQCEOUR 
PROCEDUR 
PROCEDUR 
PROCEDUR 
PROCEDUR 
PROCEDUR 
PROCEDUR 
PROCEDUR 
PROCEDUR 
PROCEDUR 
PROCEDUR 
PROCEDUR 
PROCEDUR 
PROCEDUR 
PROCEDUR 
PROCEDUR 
PROCEDUR 
PROCEDUR 
BEGI^^ 
IF 



fixedtofloat; 

floattofixeo; 



forward; 

FORWARD; 



GETPUT(LPSW:SHRTINT); FORWARD; 
IMSAPP(LPSW:SHRTINTJ ; FORWARD; 
PCK; FORWARD; 
REAOIR; FORWARD; 

TITLE; forward; 

UNPCK; FORWARD; 
WRITEIR; FORWARD; 

wRITOut(cname:alfa); forward; 
ifstat; forward; 

CASeSTAT;FORWARD; 

repeatstat;forward; 

whilestat;forward; 

forstat;forward; 

gotostat;forwaro; 

withstat;forward; 

cqmpstat;forward; 

stateme^t;forward; 

setsdname; forward; 

typedecl(var tl:integer; pi:ctp); forward; 

80dy(surrptr,firstentry:ctpi ; forward; 

outch; 



• 
• 






end 



C=EOL then 

8EGIN PI'TISYSPRINT) ; 

SYSPRlNTa:=BLANKLlNE; PTOUT:=0 
ELSE BEGIN PTOUT := PTOUT+l; 

SYSPRlNTaCPTOUT) := C 
END 

END «outch»»; 

PROCEDURE OUTALF; 

VAR AA s CWORO ; I : SHRTINT ; 
BEGIN UMPACK(A,AA,l) ; 

FOR I i~ 1 TO WIDTH 00 

SYSPRINTatPTOUT+I) := AACI) ; 

PTOUT := PTOUT+WIDTH; 
END " OUTALF « ; 

PROCEDURE OUTI; 
» PRINT VAL DECI?^AL IN LGTH PLACES. LEADING ZEROES ARE SUPPRESSED « 

VAR s,si : Integer; 

I*J : SHRtINT; 

DIGIT : ARRAY (0-.17) OF ShrTinT; 
begin I := 0; J := LGTH - I; S := ABStVALI; 

REPEAT SI := S DIV 10; OIGITUI J= S - Sl*l0 ; 
S := SI; I := I ♦ l; 

UNTIL S = 0; 

WHILE J > I DO 

8EGIN J := J - l; OUTCHf » •) END; 

IF VAL < THEN OUTCH('-«} ELSE OUTCH I » »); 

REPEAT 1 ■•!= I - l; 

OUTCHlHEXCHARCOIGITd) H ; 
UNTIL I = O; 
END « OUTI » ; 

PROCEDURE OUTHEX; 
« PRINT VAL IN WIDTH HEXADECIMAL PLACES* PRECEDED BY A SPACE« 
VAR : ARRAY M..8) OF BYTE; 



480. 
481. 
482. 
4fi3. 
484. 
485. 
486, 
487. 
488. 
489. 
490. 
49 1. 
492. 
493. 
494. 
495. 
496. 
497. 

49 8. 
499. 
500. 
501. 
502. 

50 3. 
504. 
505. 
506. 
507. 
508, 
509. 
510. 
511. 
512. 
513. 

514. 
515. 
516. 
517. 
518. 
519. 
520. 
521. 
522. 
523. 
524. 

526. 
527. 
528. 
529. 
530. 
531. 
532. 
533. 
534. 
535. 
536. 
537. 
538. 
539. 



I,VAL : INTEGeR; 
BEGIN OUTCH( » •); VAL :=FVAL; 
FOR I := WIDTH OOWNTO 1 00 
BEGIN 

0(1) := VAL MOD 16; 
VAL := VAL DIV 16; 
ENID; 
F3R I := 1 TO WIDTH DO DUTCH IHEXCHAR ( 0( U )) ; 
END "OUTHEX"; 

PROCEDURE PRTERR; 

VAR I : SHRTINT; 
BEGIN SYSPRIMTa:=BLANKLINE; PToUT:=0; OUTCH(« •»; 

FOR I := 1 TO 4 DO OUTCHt**'); 

FOR I:=l TO ERRINX DO 

SySPRlNT3CeRRLlSTri).P0S+7} := •!•; 

PTOUT I ~ 80. 

FOR I := 1 TO ERRINX 00 QUtI lERRLI ST< I) .NWR,4» ; 

QUTCH(EDL); ERRINX j= 0; POSl := 0; 

END «prterr"; 

PROCEDURE NEXTCH; 

"READS NEXT CHAR OF FILE INPUT. 
CONVERTS EOL TO BLANK* 

PRINTS ERROR SUMMARY AFTER EACH LINE IIF ERRORS PRESENT) 
AND PRINTS ADDRESS AT BEGINNING OF LINE »' 
BEGIN 

IF EQLFLAG THEN 

BEGIN IF ERRINX > O THEN "PRINT ERRORS" PRTERR; 
EOLFLAG := FALSE; CHCNT i= 0; 
IF LISTING THEN 
BEGI^J 

IF DP THEN OUTHEXlLCffe) ELSE 0UTHEXMC,6); 
OUTGH( » »i; 
END; 

GETCSYSIN); CHPTRX:=72; 
WHILE ICHPTRX>0) £ (SYSl NatCHPTRX)** ») 00 

CHPTRX:=CHPTRX-1; 
IF CHPTRX<=0 THEN CHPTRX:=0; 
SYSINa(CHPTRX-H):=EOL; 
CHPTRX:=l; 
END "EOLFLAG"; 

CH:=SYSINa(CHPTRX); CHPTRX:*CHPTRX+l ; 
IF LISTING THEN OUTCH(CH) ; CHCNT := CHCNT + 1; 
IF CH = EOL THEN 

BEGIN CH := » •; EOLFLAG '= TRUE END; 
END "NEXTCH"; 

PROCEDURE ERROR; 

BEGIN »mEm{41BJ := InTCTRUE>; ERRFLAG" 
Err ; St TRUE' 
"ERRNRSd DIV 30) := ERRNRSd D|V 301 |tl MOO 30) ; " 
IF ERRINX >= 9 THEN 

WITH ERRLISTCIOI 00 

BEGIN POS := ; NMR := 104 ; ERRINX i= 10 ; 

"ERRNRSJNMR DIV 30) := ERRNRSiNMR DIV 30) MNMR MOD 30) I" 
END ELSE 
BEGIN IF CHCNT > POSl THEN POSl := CHCNT ; 
ERRINX := ERRINX * 1; 
WITH ERRLIST(ERRINXJ DO 
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540. 




BEGIN POS 1= POSl; 


NMR ; = 


I END; 


541. 




POSl := POSl + I; 








542. 




END; 










543. 


ENf 


> "ERROR"; 








544. 














545, 


PROCEDURE 


errhessage; 








546, 




VAR IT3 ; shRtint : 








547. 


BEGIN ERR0R(43) ; OUTCH(EOL) ; 






54R. 




FOR IT3 := 1 TO 9 DO 


OUTALFt BLANK 


flO) ; 


549. 




0UTALF{ALF,10) ; 0UT1{VAL,7) 


; DUTCH (EOL) ; 


550. 




IF ^eOLFLAG THEN 








551. 




FOR IT3 := I TO CHCNT+3 DO OUTCH{ 


• *) ; 


552. 


ENC 


> "ERRMESSAGE"; 








553. 














554. 


•♦ I 


N S Y M 8 L 


READS 


ONE PASCAL- 


555. 


" LIST OF 


SYMBOL NUMBERS 


' 






556. 


NO 


CL 


SYMBOL 


NO 


CL 


SYMBOL 


557. 














558. 


1 




ID 


20 






559. 


2 


1 


INTEGER Const 


21 




BEGIN 


560. 


2 


2 


REAL CONST 


22 




END 


561. 


2 


3 


ALFA CONST 


23 




IF 


562- 


2 


4 


CHAR CONST 


24 




THEN 


563. 








25 




ELSE 


564. 








26 




CASE 


565. 


5 


I 


-n 


27 




OF 


566. 


6 


I 


« 


28 




REPEAT 


567. 


6 


2 


/ 


29 




UNTI L 


568. 


6 


3 


fi 


30 




WHILE 


569. 


6 


4 


DIV 


31 




00 


570. 


6 


5 


MOD 


32 




FOR 


571. 


7 


1 


*■ 
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1 


TO 


572. 


7 


2 


- 


33 


2 


DOWNTO 


573, 


7 


3 


1 


35 




GOTO 


574. 


8 


1 


< 


36 




NIL 


575. 


8 


2 


<= 


37 




TYPE 


576. 


8 


3 


>= 


38 


i 


ARRAY 


577. 


8 


4 


> 


38 


2 


RECORD 


578. 


8 


5 


-»= 


38 


3 


FILE 


579. 


8 


6 


= 


38 


4 


CLASS 


580. 


8 


7 


IN 


38 


5 


powerSet 


581. 


9 




{ 


40 




LABEL 


582. 


10 




) 


41 




CONST 


583. 


11 




SET 


42 




PACKED 


584. 








43 




VAR 


585. 


15 




f 


44 




FUNCTION 


586. 


16 




•» 


45 




PROCEDURE 


587. 


17 




. 


47 




VALUE 


588. 


18 




a 


48 




WITH 


589. 
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« 
« 








590. 














591. 




MOT PASCAL SYMBOLS : 


BLANK ♦ 


» 


n 


592. 














593. 


PROCEDURE 


INSYMflOL; 








594. 




VAR SCALE, EXP : SHRTiNT; R, 


FAC 


: REAL; 


595, 




I.J, 


fK : SHRTINT; 


8t1,SIGn 


tSlZEOK J BOOLE 


596. 




CHTYPE I BYTE; 








597. 














59 8. 




PROCEDURE option; 








599. 




VAR 


CHl ; CHAR; 
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600. BEGIN 

601. REPEAT MEXTCH; CHI i= CH; NEXTCH; 

602. IF CHI = ♦A* THEN ASSCHECK := CH = •+» ELSE 

603. IF CHI = *Z* THEN PRCODE := CH = •+» ELSE ! 

604. IF CHI = 'D' THEN DIVCHECK := CH = •+• ELSE j 
505, IF CHI = 'L* THEN LISTING := CH = •+« ELSE 

606. IF CHI = 'Oi THEN STOFlCHECk := CH =«+t ELSE 

607. IF CHI = ipt jHeN PCOOE := CH = •■»-» ELSe * 

608. IF CHl ^ •)(' THEN INXCHECK := CH = »-«•' ; 

609. NEXTCH; ' 

610. UNTIL CH--=',» ' 

611. END " OPTION "; i 
612. 

613. BEGIN I 

614. 1: WHILE CHARTYPE(CH) = 00 NEXTCH; "BLANKS AND ILLEGAL CHARACTERS" j 

615. NO := SYMNO<CH); 

616. CL := SYMCL(CH); 

617. CASE CHARTYPECCH) OF ; 

618. l: "A LETTER - MUST BE THE START OF AN IDENTIFIER OR 

619. RESERVED WORD" I 

620. BEGIN UNPACK(BLANKALFA,A,l)1 I := OJ ! 

621. REPEAT IF I < ALFALENG THEN i 

622. BEGIN I := 1*1; Ad) := CH; END; | 

623. NEXTCH; CHTYPE := CHARTYPECCH) 1 

624. UMTIL -.( ICHTYPE = IJ |(CHTYPE=2)n | 

625. pACKtA,l,AVAL); I 

626. FOR J := WL{ I) TO WLM + D-l 00 

627. IF AVAL = WDCJ) THEN [ 

628. BEGIN NO := WNO(J); CL := WCLU); ENq; \ 

629. EMO; 1 

630. I 

631. 2: "A DIGIT - MUST BE A NUMBER CONSTANT" 

632. BEGIN SIZEOK := TRUE; I VAL := 0; 

633. REPEAT 

634. BEGIN IF 1VAL>MAX10 THEN SIZEOK := FALSE; 

635. . IF SIZEOK THEN 

636- IVAL := IVAL*10 * CINT(CH) - INTCO*!!; 

637. NEXTCH 

638. end; 

639, until chartypeich) -= 2; 

640, if -»sizeok then begin ival := 0; err0r(2) end; 

641. SCALE := 0; 

642. IF CH = «,» THEN 

643. BEGIN NEXTCH; IF CH = «.» THEN CH :- «:» E^sE 

644. BEGIN RVAl := IVAL; CL := 2; 

645. IF CHARTYPECCH) -.=2 THEN ERROROi ELSE 

646. rEpEAT R := INT<CHI - INT|»0M; | 

647. RVAL := TEN*RVAL ♦ R; ! 

648. SCALE := SCALE - I; NEXTCH 

649. UNTIL CHARTYPECCH) -,=2; I 

650. END; ! 

651. END; I 

652. IF CH = »E» THEN i 

653. BEGIN IF SCALE = THEN I 

654. BEGIN RVAL :* IVAL; CL := 2 END; i 

655. SIGN := FALSE; NEXTCH; I 

656. !F CH = »+• THEN NEXTCH ELSE | 

657. IF CH = '-» THEN | 

658. BEGIN NEXTCH; SIGN := TRUE END; 

659. EXP := 0; I 






660. WHILE CHARTYPE!CH)=2 DO 

661. BEGIM ex.? := 10*EXP + (INT(CH) - INTC'O'H; 

662. NEXTCH 

663. END; 

664. IF SIGN THEN EXP := -EXP; 

665. SCALE := SCALE + EXP 

666. END; 

667. IF SCALE -^ THEN 

668. BEGIN R := ONE; 

669. IF SCALE < THEN 

670. BEGIN FAC := TENTH; SCALE := -SCALE END 

671. ELSE FAC J« TEN; 

672. REPEAT IF oODIsCAlE) tHEn R := R*FAC; 

673. <=4C := SOR^^aC); SCALE := SCALE OlV 2 

674. UNTIL SCALE = 0; "R = lO ** SCALE" 

675. RVAL := RVAL*R 

676. end; 

677. end; 

678. 

679. 3: » it - MUST BE A HEXAOECIHAL CONSTANT" 

680. BEGIN IVAL := 0; NEXTCH; CHTYPE := CHARTVPEC CHI ; 

681. WHILE {CHTVPE-2) )(CHTYPE=I) DO 

682. BEGIN CASE CHTYPE OF 

683. I: J ;= INT(CH) - INTf»A') + 10; 

684. 2: J := INT(CH) - INT(»0«); END; 

685. IVAL := IVAL*16+J; 

686. NEXTCH; CHTYPE J^CHARTYPECCHI ; 

687. END; 

688. END; 
689. 

690. 4: " -• - CHECK FOR -»= « 

6*^1. BEG!^ NEXTCH; 

692, IF CH = •=» THEN BEGIN NO J= 8; CL :~ 5; 

693, NEXTCH END; 

694, END; 
695. 

696, 5: '♦ < - CHECK FOR <= " 

697. BEGIN NEXTCH; 

698, IF CH = •=» THEN BEGIN CL := 2; NEXTCH END; 

699. END; 
700, 

701. 6: " > - CHECK FOR >= " 

702, BEGIN NEXTCH; 

703, IF CH = ♦=» THEN BEGIN CL := 3; NEXTCH END; 

704. END; 
705, 

706. 7: •• . - CHECK FOR ,. « 

707. BEGIN NEXTCH; 

708. !F CH = •.« THEN bHGIn NO := 19; NEXTCH END; 

709. EnD; 
710. 

711. a: '♦ : - CHECK FOR := « 

712. BEGIN NEXTch; 

713. IF CH = «=» THEN BEGIN NO :» 20; NEXTCH END; 

714. END; 

716! 9: « «'• - CHECK INSIDE COMMENT FOR OPTION SWITCHES " 

717. BEGIN NEXTCH; | 

718. IF CH = *$' THEN OPTION; 

719. WHILE CH -.= ♦"» DO NEXTCH; 
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720. 
721. 
722. 
723. 
724. 
725. 
726. 
727. 
728. 
729. 
730. 
731. 
732. 
733. 
734. 
735. 
736. 
737. 
738. 
739. 
740. 
741. 
742. 
743. 
744. 
74 5. 
746. 
747. 
748. 
749. 
750. 
751, 
752. 
753. 
754. 
755. 
756. 
757. 
758. 
759. 
760. 
761. 
762. 
763. 
764. 
765. 
766. 
767. 
768. 
769. 
770, 
771. 
772. 
773. 
774. 
775. 
776. 
777, 
778. 
77 9. 



nextch; goto i; 

END; 

10: " • - AN ALFA OR CHAR CONSTANT » 

BEGIN UNPACK<BLANKALFAfA,ll ; NO := 2; K := 0; BTl := FALSE; 
REPEAT NEXTCH; 

IF CH = • » •« THEN 

BEGIN nextch; BTl := CH -.= "»» END; 

IF -BTl THEN 

IF K = ALFALENG THEN 

BEGIN ERR0R{94J; BTl := TRUE END ELSE 
BEGIN K ;= K + 1; A{K) := CH END; 
UNTIL BTl; 

IF K =1 THEN " CHAR CONST " 
BEGIN CL:=4; CHVAL := A(l) END 
ELSE " ALFA CONST •• 

BEGIN PACK CA,l,AVALl; CL :* 3 END; 
END; 

11: "OTHER SYMBOLS - 00 NOTHING ELSE - N0,CL AlP-EAOy SET" 

nextch; 

end; 

end "IM SYMBOL" ; 

PROCEDURE SRCHREC; 

•» SEARCHES ONE BLOCK, RETURNS CTPTR « 
BEGIN CTPTR := P; 

WHILE CTPTR -= NIL DO 

IF CTPTRa.NAME = AVAL THEN GOTO I 
ELSE CTPTR := CTPTRa.NXTEL; 
I: END « SRCHREC « ; 

PROCEDURE SEARCH; 

" SEARCHES C0NTEXTTA8LE, RETURNS CTPTR AND DISX = INDEX TO 

DISPLAY » 
VAR I : SHRTINT; 
BEGIN FOR I := Tqp OO^NTq q dO 

8EGIM CTPTR := DI SPLAYJU -FNAME; 
WHILE CTPTR -,= NIL 00 

IF CTP1^3,Hh^E = AVAL THeN GOTO I 
ELSE CTPTR := CTPTRS.NXTeL ; 
EnO; 
1: DISX := I; 

END " SEARCH •• ; 

PROCEDURE INCONST; 

" INPUT PARAMETER : NXT. SEARCHING IS TO BEGIN AT NXT 
OUTPUT PARAMETER : V = KIND OF CONSTANT 

P = TYPE POINTER , P - NIL IF ERROR •• 
VAR SIGN : BOOLEAN; PT : CTP; 
BEGIN SIGN := FALSE; P := NIL; 
IF NO = 7 THEN 
BEGIM SIGM := Cl = 2; 

IP CL <= 2 THEN IN SYMBOL; 
END; 

IF NO = 2 THEN 
BEGIN CASE CL OF 
I: BEGIN P := INtPTR; V :« INTEGERS; EnD; 
2: BEGIN P := REALPTR; V := REALS; END; 
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780. 3: BEGIM P := ALFAPTR; V := ALFAS; END; 

781. 4: BEGIM P := CHARPTR; V := CHARS; I VAL:=INT{ CHVAL) ; END; 

782. END; 

783. END ELSE 

784. IF NO = 1 THEN 

785. BEGIN PI := CTPTR; 

786. SRCHRECCNXTl; 

787. If CTPTR = NIL THEN SEARCH; 

788. IF CTPTR = NiL THEN ERR0R(12) ELSE 

789. WITH CTPTRa 00 

790. BEGIN IF IKLASS -= KONST) | ( CONKI NO = FORMAL) THEN ER^0R(63) 

791. ELSE 

792. WITH VALUES OO 

793. BEGIN P := CONTYPE; V := KONSTKIND; 

794. CASE V OF 

795. INTEGERS, CHARS, SYMBOLICS: I VAL := IVALUE; 

796. REALS: RVAL := RVALUE; 

797. ALFAS: AVAL := AVALUE ; 

798. END "CASE V" ; 

799. END; 

800. CTPTR := PT; "ORIGINAL PASCAL DIFFERS HERE" 

801. END; 

802. END ELSE ERR0RI3I; 

803. IF SIGN THEN 

904. BEGIN IVAL := -IVAL; RVAL := -RVAL END; 

805. END " INCONST » ; 

806. 

807. PROCEDURE GENJP; 

808. BEGIn 

809. " IF GATTR.KIND -»= LCONO THEN " » 

810. If= GATTR.TyPTR-.=300LPTR THEN ERR0R(57I 

811. ELSE BEGIN LOADCGATTRJ; 

812. GENRRI#12,STK(RP),STKI«P)) ; "LTR" 

813. G6NRX{#47,3,0,0f0); "BC FALSE " 

814. IF FJPADDR-»=0 THEN INS CF JPADDR,IC-2> 

815. END 

816. •• ELSE BEGIN «"STUFF FOR LCOND GOES HERE"" END " 

817. END "GENJP"; 
818. 

819. PROCEDURE GENRR; 

820. BEGIN 

821. !F IC>=C3D^Ax-2 THEN BEGIN ERR0R(90} ; IC:*0 END; 

822. CODEC IC):=OP; CODEC IG*l J :=Rl*16+R2; 

823. If PRCQOE ThEN PRINTcCFALSe) • 

824. lC:=lC+2 

825. END "GENRR"; 
826 . 

827. PROCEDURE GENRS; 

828. BEGIN 

829. IF IC>=C0D^AX-4 THEN BEGIN ERR0RC90); IC:=0 END; 

830. CODEi IC):=OP; CODEC IG+l) :=RI*16*R3; 

831. CODEC IC + 2):=XB2*l6-«-X02 DIV 256; CODE C IC+3 ) : = X02 MOD 256; 
332. IF PRCODE THEN PRINTC C FALSE M 

833. IC:=IC+4 

834. END "GENRS"; 
835. 

836. PROCEDURE GENRX; 

837. BEGIN 

838. IF ie>=C00HAX-4 THEN BEGIN ERROR(90}; ie:=0 END; 

839. CODEC IGH-OP; CODEC IC + I) :=R1*16+XX2 ; 
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840. 
841. 
842. 
843. 
844. 
845. 
846. 
847. 
848. 
849. 
850. 
851. 
852. 
853. 
854. 
855. 
856. 
857. 
858. 
859. 
860- 
861. 
862. 
863. 
864. 
865. 
866. 
867. 
868. 
869, 
870. 
871. 
872. 
873. 
874. 
875. 
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877. 
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880. 
881. 
882. 
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884- 
885. 
886 . 
8 87, 
888. 
889. 
890. 
891. 
89 2. 
89 3. 
894. 
895. 
896. 
897. 
898. 
899. 



IC:=0 END; 



C0DE(IC+2J:=XS2*16+XD2 DIV 256; 

CDDEC IC+3):=X02 MOO 256; 

IF PRCOOE THEN PRINTC ( FALSE > ; 

IG:=IG+4 

END "GENRX"; 

PROCEDURE GENSI; 
BEGIN 

IF IC>=C0DMAX-4 THEN BEGIN ERR0R.(90); 

CODEC IC):=OP; CODEC IG+1 } :=XI2 ; 

CODEC IC+2I:=XB1*16+XDI DIV 256; 

CODEC IC+3):=XDl MOD 256; 

IF PRCOOE THEN PRINTC ( FALSe ) ; 

lG:=lC+4 
END »'GENSI»; 

PROCEDURE GENSS; 
BEGIN 

IF IG>=C00MAX-6 THEN BEGIN ERR0RC90J; IC:=0 END; 

COOE(IC):=OP; CODEC IC+l):=XL; CODE CIC+2 ) :=X8l*16+XDl DIV 256; 

CODEC IC + 3n = X0l MOO 256; CODECIG+4} :=XB2*16+X02 DIV 256; 

CODEC IC+5}:=XD2 MOD 256; 

IF PRCOOE THEN PRINTC CFALSE) ; 

IG:=IC+6 
END "GENSS"; 

PROCEDURE CHECKBNDS; 
BEGIN 

END »checkbnds«; 
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8 : ShrTiNt; 



pRqCEOurE Ins; 

var laor : address; 

BEGIN 

LAOR := FADR; 

If LADR >= -^095 Then begin B: = BAS£REG(2t ; LAOR 

ELSE 8 := 8ASEREGC1I; 

C0DECFCA):=B*16+LA0R DIV 256; 

CODECFCA+ll:=LAOR HOD 256 
END "INS"; 



LADR-4096 End 



PROCEDURE 
"MULOPT 



mulopt; 

DECIDES 



IF VAL = 2aEXPl : 

= 2aEXPl*C2aEXP2+ll : 

= 2iEXPl*C23EXP2-lJ : 

OTHER : 



OPT 


« PUREP 


opt 


= POSP 


OPT 


= NEGP 


OPT 


= NOOPT " 



VAR El,E2 : SHRTINT; 
VAL : SHRTINT; 
BEGIN IF VAL I > THEN 
BEGIN El := 0; 
VAL := VAL I ; 
WHILE -.ODDCVAL) DO 
BEGIN VAL -:= VAL OlV 
IF vAl = I THEN 
BEGI^J OPT := PUREP; 
BEGIN VAL := VAL DIV 
IF ODD C VAL) THEN 
BEGIN 

REPEAT VAL := VAL 01 V 2 

UNTIL -.QDDCVAL}; 

IF VAL > THEN OPT 



m 



El := El + 1 END; 



EXPl := El 
2; E2 := 1; 



END ELSE 



E2 := E2 + I 



:= NOOPT ELSE 
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900. BEGIN OPT := NEGP; 

901. EXP2 := E2; E^Pi :* El; 

902. end; 

903. END ELSE 

904. BEGIN 

905. REPEAT VAL := VAL DIV 2; E2 := E2 + I; 

906. UNTIL ODD(VAL); 

907. IF VAL > 1 THEN OPT := NOOPT ELSE 

908. BEGIN OPT := POSP; 

909. EXP2 := E2; EXPl := El; 

910. END; 

911. END; 

912. END; 

913. EMD ELSE OPT := NOOPT; 

914. END "MULOPT"; 
915. 

916, FUNCTION L0G2; 

917- VAR E : SHRTINT; VAL : INTEGER; 

918. SEGIM £ := I; 

919. VAL := VALl; 

920. HHILE VAL > DO 

921. BEGIN VAL := VAl OIV 2; E := E ♦ I END; 

922. L0G2 := E; 

923. END «L0G2«; 
924. 

925. 

926. PROCEDURE SKIP; 

927. BEGIN 

928. WHILE (ERRCLINO) = IRReLSY}E( FNO -.= NO) DO 

929. IF (MO = 38I£<CL = 2) THEN ••RECORD" 

930. BEGIN REPEAT INSYW80L; SKIPC49); 

931. ••UNTIL -.INO IN SETi 16,26)); '• 

932. UNTIL -.CCNQ=16)MN0=26)); 

933. IF H3 = 22 THEN INSYMBOL ; 

934. END ELSE INSYMBOL; 

93 5. End « SKip " ; 

936. 

937. PROCEDURE PRINTc; 

938. VAR A:ALFA; LIMEjPRI NTLI NE ; LPTqUti SHRTINt; 

939. BEGIN 

940. LINE:=SYSPRlNTa; LPTOUTr^PTOUT ; SYSPRINT3:=8LANKLINE; PTOUT^^O; 

941. [1UTHEX(IC,6); OUTALFf BLANKALFA»2) ; 0UTniGf4); 

942. aUTALF(BLANKALFA»4); 

943. IF CODE! IC)>=256 THEN 

944. BEGIN OUTALFI* ERROR ',10); OUTALF { BLANKALFA,5 ) ; 

945. OUTKCOOECIG), lOI; OUTH CODE( IC+1 ) ,10) ; 

946. IF INC THEN lC: = IC-i-2 

947. END 

948. ELSE BEGIN 

949. PACK(HNEMCCODE( IC)),0,AI; 0UTALF(A,4|; 

950. 0UTALF(BLANKALFA,4) ; 

951. IF C3DE(IC)<=63 THEN 

952. BEGIN ••RR-FORMAT*' 

953. OUTKCODEI IG+1) DIV I6f2); OUTCH{»,«); 

954. OUTKCODECIC + I) mqO 16,2); 

955. IF Ih^ THEfs^ Ic: = lC + 2; 

956. ENO 

957. ELSE IF C00E(IC)<=127 THEN 

958. BEGlf^ »»RX-Fo'^mAt«' 

959. OUTKCODEI IC-i-ll OIV 16,2)5 OUTCHC»»»); 






960. OUTI(CODE( IG+3)-«-256*(C0DEl IC+2) MOO 16), 4); 

961. nUTCHCC); QUTI(C0DE(IC + 1) MOD 16,2); 

962. OUTCH{«,M; OUTI (CODE( IC+2 ) OIV 16, 2U 

963. OUTCH{«J«J; 

964. IF INC THEN IC:=IC+4 

965. ^-HD 

966. ELSE IF ( ( 134<=CoDE ( IC ) ) £(C00e { I C) <=1^^) ) j (CODEC IC ) =152 ) ^HEN 

967. BE^^N "RS-FORMAT" 

968- OUTIlCODECIC+l) DlV 16»2); OUTCHi*,'); 

969. OUTUCODEC IC+1) MOD 16,2); OUTCH(',»); 

970. 0UTl(C3DE{ Ic+3)+256«{C0DEiIG+2) MOD 16)t4); 

971. OUTCHIM'J; 0UTItC0DE{lC+2) DiV 16,2); OUTCHCM*); 

972. If INC THEN IC:=IC+4 

973. END 

974. ELSE IF C0DECIC)>191 THEN 

975. BEGIN "SS-FORMAT" 

976. 0UTI(C0DE(IC+3)+256*(C00E(IG+2) MOO 161,41; 

977. OUTCH(M«); OUTI (CODEC IC + 1) ,3) ; OUTCHC,'); 

978. 0UTnC0DE(!G+2l DIV 16,2); OUTCHC»)M; OUTCHC,'); 

979. OUTICCQDEC IC+5)+256*(C0DE(IC+4J MOD 16), 4); QUTCH(»(»I; 

980. OUTICCODEC 104) DIV 16,2); OUTCHC)'); 

981. IF INC THEN lC:=IC+6 

982. END 

983. ELSE 

984. BEGIN '»Si-F0RMAT« 

985. OUTKCOOEi IG+3)+256*iC00E(IC+2) MOD 16), 4); OutCH(«{»); 

986. OUTI(CODECIC+2I DIV 16,2); aUTCH(*)»l; OUTCH(»,»); 

987. 0LITUC0DEclC + l),3); 

988. l^ iNC THEN lG:=IC+4 

989. END 

990. end; 

991. PUTiSYSPRINT); SYSPRI NT3:==LINE ; PT0UT:=LPT0UT ; 

992. END «PRINTG"; 
993, 

994. PROCEDURE PRTCOMP; 

995. VAR ICSAVE : ADDRESS; 

996. BEGIN 

997. OUTCH(EOL); 

998. ICSAVE:=1G; 

999. IC:=0; 

1000. PRINTC(TRUe); 

1001. IC:=IG+16; "SKIP AROUND CONSTANTS" 

1002. WHILE IC<ICSAVE ^0 PRInTC( TRUE) ; 

1003. END «PRtCqmp«i; 
1004. 

1005. PROCEDURE PRINTCT; 

1006. B^GlM 

1007. OUTCH(EOL); OUTAlFI »PRINTCT N0» ,10) ; 

1008. 3UTALF(«T IMPLEMEN',10); OUTALF( »TED • ,3 ) ; 

1009. OUTCHCEDL); 

1010. END «PRTCOMP"; 
1011. 

1012. PROCEDURE STKERR; 

1013. BEGIN 

1014. IF ISTKtIM<MAXISTK THEN 

1015. BEGIN ISTfCLIM:=ISTKLIM+l; RP: = RP+l; ASTK(RP|;=0 END 

1016. ELSE ERR0RC33); 

1017. End "STKERR"; 
1018. 

1019. PROCEDURE GENCONST; 
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1020, 
1021. 
1022. 
1023. 
1024. 
1025. 
1026. 
102T. 
1028. 
1029. 
1030. 
1031. 
1032. 
1033. 
1034. 
1035. 
1036. 
1037. 
1038- 
1039. 
1040. 
1041, 
1042. 
1043. 
1044. 
1045. 
1046. 
1047. 
1048. 
1049. 
1050. 
1051. 
1052. 
1053. 
1054. 
1055. 
1056. 
1057. 
105 8. 
1059. 
106D. 
1061, 
1062. 
1063. 
1064. 
1065. 
1066. 
1067. 
1068. 
1069. 

1070- 
1071. 
1072, 

1073, 
1074. 

107 5. 
1076. 
1077. 
1078. 
1079. 



WITH CSTTBCNTJ DO 
THEN GOTO 1 



VAR X:R6AL? AA,E:ALFA; I:INTEGER; LAST, NT: SHRTINT; 
BEGIN 

WITH FVAL DO 
CASE KONSTKIND OF 
REALS: 

BEGIN X:=RVALUEi NT:=RLCX; 

WHILE NT-. = DO WITH CSTTB(NT) 00 
IF X=VALU. RVALUE THEN GOTO I 
ELSE NT:=CNEXT; 
LAST:=RLCX; 
RLCX:=CHN1X 
end; 

INTEGERS: 

BEGIN I:=iVaLUe; IF ABS(n<=32767 THEN Nj.^HlCx ElS^ NT: = PlCX; 

lAst:=nt; 

WHILE NT-.= do 

IF I=vALU.IVALUe 
ELSE NT:=CNEXT; 
IF ABSCI><=32767 THEN HLCX:=CHNIX ELSE FLCX:=CHNix 
ENO; 
ALFAS: 

8EGIM AA:=AVALUE; NT:=ALCX; 

WHILE NT-.=0 DO WITH CSTTStNTJ DO 
IF AA=VALL}.AVALUE THEN GOTO 1 
ELSE NT:=CNEXT; 
LAST:=ALCX; 
ALCX:=CHNIX 
END; 
EXTREF: 

BEGIN E:=EVALUE; NTi=ELCX; 

WHILE NT-.= 00 WjIh cSTtbCNTJ DO 

IF e=valu.evalue Then go^o i 

ELSE NT:=CNEXT; 
LAST:=ELCX; 
ELCX:=CHNIX 
END; 
END; "CASE KONSTKIND" 
WITH CSTTB(CHNIXI DO 

BEGIN CNEXT:=LAST; VALU:=FVAL; INX:=0 END; 
NT:=sCHNIX; 

IF CHNIX<CSTMAX THEN CHNI X:=CHNI X+l ELSE ERR0RC84); 
l: WITH CSTT8(NT) DO 

BEGIN COnE(FCA|:=INX OIV 256? CQ0E(FCA+1 ) :=INX NOD 256; 
INX:=FCA END 
END "GENCQNST"; 
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PROCEDURE LDCST2; 
VAR OP: SHRTINT; 
BEGIN 

0P:=0; 

WITH FVAL DO 

CASE K3?JSTKIN0 OF 

INTEGERS: 

IF CIVALUE>=0}S(1VALUE<«4095) THEN 

GENRX(#4l,FRR»IVALUE,0,0l "LA" 
ELSE IF ABSCIVALyEJ<=32767 THEN 0P:=#48 "LH" 
ELSE 0P:=#58; "L" 
REALS: OP: =#68; 
EXTREF: 0P:=#58; 
ALFAS: frroR<85); 
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1080. 
1081. 
1082. 
1083. 
1084. 
1085. 
1086, 
1087. 
1088, 
1089. 
1090. 
1091. 
1092. 
1093. 
1094. 
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1096. 
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1098. 
1099. 
1100. 
IIOI. 
1102. 
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1104. 
1105. 
1106. 
1107. 
1108. 
1109. 
1110. 

nil. 

1112. 
1113. 
lll^. 
1115. 
1116. 
1117. 

1118. 
1119. 
1120- 
1121. 
1122. 
1123. 
1124. 
1125. 
1126. 
1127. 
1128. 
1129. 
1130. 
1131. 
1132. 
1133. 
1134. 
1135. 
1136. 
1137. 
1138. 
1139. 



END; "CASE KONSTKINO" 
IF 0P-^=0 THEN 

BEGIN GEMRXlOPfFRP,OfO,0); 

GeMC0MST(FVAL,IC-2) END 
END ••L0CST2"; 



PROCEDURE LDCST; 
VAR RREG:SHRTINT; 
BEGIN 

RREG:=0; 
WITH FVAL DO 
CASE KONSTKIND OF 
INTEGERS, EXTREF: 

BEGIN IF RP<ISTKLIM 



RREG:=STKCRP) 



THEN RP:=RP+1 ELSE STKERR; 

END; 



REAtS: 
BEGIN 



IF RRP<MAXRSTK THEN RRP:=RRP*1 ELSE EBR0RJ33n 
RREG:=RSTK(RRP) ENOJ 
ALFAS: ERR0R<84)J 
end; "CASE KONSTkiND" 
LDCST2(FVAL,RREG) 
END "LDCST«; 

PROCEDURE GENADDR; 

VAR XCONStCONSTANT; RPD,LX:SHRTINT ; D:ADORESS; 

BEGIN 

HITH FATTR,RXADDR DO 
BEGIN 

B2:=0; X2:=0; D:=DPLMT; 

IF ACCESS-.=ORCT THEN LX :=sSTK (RP-H ; RPO:«I; RP:=RP-H; 

IF TyPTR-.=NIL THEN 

IF PCKD THEN ERRORl 87} 

else begin 
if access=inorct then begin rpd:=rpd+1; b2:=lx end 
else if breg=0 then 82:=gl0balreg 
else ip breg=level then 82:=localreg 
Else b6gim 

IF RP<IST'<LlM 7HEN RP-^RP+l EtS^ STKERR; 
RPD:=RPD+l; B2:=STK(RP); L0ADBASEIB2,BREGI 

end; 

IF ACCESS=InXo Then begin RP0:*RP0+1; X2:=LX EnD; 
IF ID<0)MD>4095J THEN 
WITH xCqnS 00 
BEGIN KONSTKIND:«INTEGERS; 

IF D<0 THEN BEGIN IVALUE:=D; D:=0 END 

ELSE BEGIN IVALUE:=D-D MOD 4096; D:=D MOD 4096 END; 

LOCSTIXCONS); RP0:=RPD-»-l; 

IF X2=0 THEN X2:=STKiRP| ELSE GENRR<#1A,X2,STKCRP) ) 

end; 

D2:=D; 

RP:=RP-RPD 
END "TYPTR-.=NIL S -.PCKO" 
END "WITH FATTR,RXADOR" 

END "GENADDR"; 

PROCEDURE GENSADOR; 
BEGIN 

WITH FATTR,RXADDR DO 

BEGIN 

IF TyptR3.SIZE>256 THEN 
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« AR" 



# 
# 






# 



1140. 
1141. 
1142. 
1143. 
1144. 
1145. 
1146. 
1147. 
1148. 
1149. 
1150. 
1151. 
1152. 
1153. 
1154. 
1155. 
1156. 
1157. 
1158. 
1159. 
1160, 
1161. 
1162. 
1163. 
1164. 
116 5. 
1166, 
1167. 
1168. 

1169. 
1170. 
1171. 
1172. 
1173. 
1174. 
1175. 
1176. 
1177. 
1178. 
1179, 
1180. 
1181. 
1182. 
1183. 
1184. 
1185. 
1186. 
1137. 
1188. 
1189. 
1190. 
1191. 
1192. 
1193. 
1194. 
1195. 
1196. 
1197. 
1198. 
1199. 



REGINJ LOAOADRCFATTR) ; 

SSAaOR.D2:=0; SSADDR.82 :=STK{RP) END 
ELSE 8EGIM GENADORC FATTR» Oi ; 
IF X2-.= THEN 

BEGIN "B2 WILL NEVER(?J BE 0" 

IF RP<ISTKLIM TVIEN RP:=RP-H ELSE STKERR; 
GENRX{#41,STK(RP)fD2»X2fB2) ; 

WITH SSAOOr Oo BEGIn d2:=0; B2:=STkCRP) END 
ENID 
ELSE BEGIN SSA0DR.D2 J=D2 ; SSA0DR.B2 :=B2 
END 
END 

End mGensaddr"; 



PROCEDURE LDAOBASE; 

VAR I : SHRTINT ; 
BEGIN GENRX(#5B,FRP,0,G,13H "L" 

FOR I := I TD LEVEL - L - 1 00 

END "LOADBASE" ; 



END 



GENRX(#58fFRP,0,0»FRP| 



PROCEDURE LOAD; 

"THIS PROCEDURE GENERATES CODE FOR LOADING A QUANTITY DESCRIBED 
BY FATTR INTO A REGISTER.'' 

VAR L0A0Typ,OPtRReG:SHRTlNT; 
lC0NST:C0NSTanT; 

BEGIN WITH FATTRtRXADOR DO 

IF KIND=VARBL THEN 
BEGIN «**«KIND=VARBL***" 

LOADTYP:= ALIGNMENT; 
"DETERMINE PROPER OP CODE" 

IF L0ADTYP=1 THEN 0P:=#43 "IC" 

ELSE IF LOADTYP-2 THEN 0P:=#48 «LH« 

ELSE IF L0ADTYP=4 THEN 0P:=#58 «L" 

ELSE IF LOAOTYP^S THEN 0P:=#68 "LO" 

ELSE ERR0R(120); 

GENADOR{FATTR,0); 



• 



OVERFLOW" 
ELSE ERROR{33) 



End 



"DETERMINE RESULT REGISTER* RREG" 
IF L0A0TYP=8 THEN 

BEGIN IF RRP<MAXRSTK THEN "NO REAL STACK 
BEGIN RRP:=RRP+1| RREGi=RSTK(RRPJ gNO 

Else beg^h 

if rp<istklih then rp := rp+1 else stkerrl 

RREG := STKtRPI; 
^NO; 

'•GENERATE CODE. SPECIAL CASE IF <CHAR>. 
ALFAULLEGALJ ALsO wUl FALL HERE" 
IF L0A0TYP=1 THEN «CHAR« 

BEGIN IF tACCeSS = DRCT)£U8REG=0) ICBREG^LEVEL)} THEN 

BEGIN GENRR(#18,RREG,RREG}; "SR - CLEAR JUNK IN RREG" 

GENRXt#43,RREG,D2,0fB2| "IG« END 
ELSE BEGIN GEnRR<#1B»0,0) ; "SR - CLEAR RO" 

6ENRXC#43,0,D2,X2,B2); "IC - LOAD INTO RO" 
G€NRRC#18fRREG,0) "LR-MOVE TO RREG" END END "CHAR" 
ELSE "REAL OR INT" GENRXCOP, RREG,D2,X2»B21 ? "ACTJAL LOAD" 
gNo "***KIND=VARBL***" 






• 
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1200. 
1201. 
1202. 
1203. 
1204. 
1205. 
1206. 
1207. 
1208. 
1209. 
1210. 
1211. 
1212. 
1213. 
1214. 
1215. 
1216. 
1217. 
1218- 
1219. 
1220. 
1221. 
1222. 
1223. 
1224. 
1225. 
1226. 
1227. 
1228. 
1229. 
1230. 
1231. 
1232. 
1233. 
1234. 
1235. 
1236. 
1237. 
1238. 
1239. 
1240. 
1241, 
1242. 
1243. 
1244. 
1245. 
1246. 
1247- 
1248. 
1249. 

1250, 
1251. 
1252. 
1253, 
1254. 
1255. 
1256. 
1257, 
1258. 
1259. 



ELSE IF KIND=SVAL THEN 
BEGIN "***KIND=SVAL***" 

IF RP<ISTKLIM THEN RP:=RP+l ELSE STKERR; 

IF VAL=0 THEN GENRRl #1B tSTKC RP ) t STK( RP) ) 
ELSE GENRXI#41,STK(RP) ,VAL»0,0) ? 
ENjD i»«**KIND = SVAL***" 



"SR« 






else if kind=lval then 
begin! '»***kind=lval***" 

rreg:=stk<rp); 

if cterm=-1 then genrrc «6, stkcrpj ♦0) «8ctr" 

else if cterm-^=0 then 

wIth lconst do 

BEGIN 

K0NSTKIND:=INTEGERS; I VALUE:*CTERM; 

LDCSTCLCONST); RP:=RP-1; 

GENRRI#lA,STK(RP)tSTK(RP+l)); 

CTERM:=0 
END 
END »«***KIND=LVAL***»« 

ELSE IF KIN0=LCOND THEN 
BEGIN »»***K!NO=LCOND***w 

"NOT YET IMPLEMENTED" 
END «***KIN0=LCON0***" 

ELSE ERR0R(507» 

END "LQAO"; 

PROCEDURE STORE; 

"THIS PROCEDURE GENERA'^'eS CODE FOR STORff^G THE QuA^tItV DEsCRiBEO 

3y fattr Into a register," 

VAR LOAOTYP,DP,RREGf IjShrTinT; 

BEGIN WITH FaTTR,RXADDR 00 
IF KIND=VARBL THEN 

BEGIN "***KIN0=VAR8L***" 
L0ADTYP:= ALIGNMENT; 

"DETERMINE PROPER OP CODE" 



IF LaAOTYP=l THEN 
ELSE IF LQA0TyP=2 
ELSE IF L0ADTYP=4 
ELSE IF L0ADTYP=3 
ELSE ErR0R(120) ; 



0Pt=#42 "STC" 
THEN 0P:=f40 "STH" 
THEN 0P:=#50 "ST" 
THEN OP: =#60 "STO" 



"DETERmNe REGISTER Tq bE STORED* RREG" 
IF L0A0TYp=9 ThEN 

BEGIN I:=0; RREG:=RSTKCRRPJ ; RRP:=RRP-l 
ELSE BEGIN RREG:=STK{RP) ; I:=l END; 

"GENERATE CODE" 

GENAODR(FATTR,I»; 

GENRXC0P,RREG,D2*X2,B21 ; 

^RP:=RP-I 

Ej^O "***KIND=VAR8L*«*« 



END 



1260. ELSE ERROR {507) 
1261. 

1262. END "STORE"; 
1263. 

1264. PROCEDURE LOADAOR; 

1265. "THIS PROCEDURE GENERATES CODE FOR LOADING THE ADDRESS OF THE 

1266. VARIABLE DESCRIBED BY FATTR INTO THE TOP OF THE STACK. « 
1267. 

1268. VAR RREG:SHRTINT; 
1269. 

1270. BEGIN WITH FATTR, RXADOR DO 

1271. IF TYPTR-.= NIL THEN 

1272. IF PCKD THEN ERRORI 87) ELSE 

1273. BEGIN 
1274. 

1275. "DETERMINE RESULT REGISTER, RREG« 

1276. GENAODR(FATTR,0); 

1277. IF RP<ISTKLIM THEN RP := RP+l ELSE STKERR; 

1278. RREG := STK(RP); 
1279. 

1280- "GENERATE CODE" 

1281. GENRX{#41,«REGfD2,X2,82); "LA" 

1282. ACC£SS:=INORCT; OPLMT:=o 
1283. 

1284, END "NOT PACKED" 

1285. 

1286. END "LOADAOR"; 

1287. 

1238. PROCEDURE AODRESSVAR; 

1289. "GENERATES CODE TO ADDRESS THE QUANTITY WITH CTPTR = FCTP AND 

1290. BUILDS UP ITS ATTRIBUTES IN FATTR" 

1291. VAR TATTR:ATTR; 

1292. BEGIN WITH FCTP3, FATTR DO 

1293. BEGIN KIND := VAR8L ; 

1294. IF KLASS'VARS THEN 

1295. BEGIN 

1296. IF VTYPES.F0RM>=CLASSS TheN ALIgNHENt:=4 

1297. Else AliGnmEnt:=alIGn 

1298. END 

1299, ELSE ALIGNMENT:=AL1GN; 
1300. 

1301. IF KLASS = VARS ThEN 

1302. BEGIN TYPTR := VTYPE ; PCKD := FALSE ; 

1303. IF VKIND = ACTUAL THEN 

1304. BEGIN ACCESS := DRCT ; DPLHT := VADOR ; BREG := VLEVEL ; 

1305. BHO ELSE 

1306. BEGIN IF RP < ISTKLIM THEN RP := RP + 1 ELSE STKERR; 

1307. IF VLEVEL = LEVEL 

1308. THEN GENRXI#5S,STK{RP),VADDR,0,LOCALREGI "L" 

1309. ELSE 8EGIM LOADBASECSTKtRP),VLEVELI ; 

1310. GeNRX<#58,STK(RP),VADDR,0,STK{RP)); "L» 

1311. END; 

1312. ACCESS := INDRCT ; OPLHt := ; ALigNMeNt v^TYPTRa.AL^GN; 

1313. END ; 

1314, End Else 

i3l5. if klass = field then 

1316. begin typtr := flotype ; 

1317. WITH DISPLAYIDISXI DO 

1318. BEGIN IF OCCUR = GMITH THEN 

1319. BEGIN ACCESS := DRCT; BREG := CLEV; DPLMT := FLDAODR * CDSPL 



m 
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1320. 
1321. 
1322. 
1323. 
132^. 
1325. 
1326. 
1327. 
132B. 
1329. 
1330. 
1331. 
1332. 
1333. 
1334. 
1335. 
1336. 
1337. 
1338. 
1339. 
1340. 
1341. 
1342. 
1343. 
1344. 
1345. 
1346, 
1347. 
1348. 
1349. 
1350. 
1351. 
1352. 
1353. 
1354. 
1355. 
1356. 
1357. 
1358. 
1359. 

1360. 
1361. 
1362. 
1363. 

1364, 

1365. 
1366 . 
1367. 
1368, 
1369. 
1370. 
1371. 
1372, 
1373. 
1374. 
1375. 
1376. 
1377. 
1378. 
1379. 



END ELSE 
BEGIN 

WITH J^^^R oo 

3EGIM ALIGNMENT:=4; KIND:=VAR8L; TYPTR:=INTPTR ; 
8!IEG: = LEVEL; DPLMT: = VOSPL ; ACCe$S:=DRCT ; 
PCKD:=FALSE; LOAOdATTRJ 

END; 

ACCESS:=imorcT; DPLMt :=FL0A0DR; AL lGNHENT:=TYPTRa.ALlGN; 

end; 

IF BITWIDTH -»= THEN 

BEGIN PCKO := TRUE ; BITaoR '= 8ITDISPL ; BITSZ := BITMIOIH 
END ELSE PCKO := FALSE 
END 
END ELSE 

BEGIN TyPTR := PROCTYPE; ACCESS := DRCT; BREG := PROCLEVEL + 1; 
DPL^T := 72 ; PCKD := FALSE ? 
ALIGNMENT:=4; 

IF PROCKINO = FORMAL THEN ERR0R(8l) ELSE 
IF LEVEL -.= BREG THEN ERR0R{B5) 

ELSE BEGIN LOAOTFATTR); ACCESS!=INORCT; DPLMTt^O; 
ALIGNMENTl=TYPTRS.ALIGN END 
END 
BHD "WITH FCTP3, FATTR" ; 
END wADDRESSVAR" J 

PROCEDURE UPALIGN; 

"Increases displ until it js a multiple of align •« 
VAR I : integer; 
begin 

if align > then 

begin i := displ moo align; 

if i > then displ := displ + align - i; 

END; 
END "UPALIGN"; 



m 



XCONS : CONSTANT; 



PROCEDURE VARIABLE ; 
VAR LATTR i ATTR ; 

xsiZE: integer; 

BEGIN ADORESSVARlCTPTRtLATTRJ ; 
INSYMBOL ; 
'♦WHILE N3 IN SET{9,17,18) 00»«"lf.f3" 
WHILE (N0=9M <N0=17) MN0=18> DO "(,.,i" 
IF NO = 9 THEN »{» 

REPEAT WiTh LATTR 00 
IF TYPTR -= NIL THEN 
If TYpTRa.FORM -.= ARRAYS ThEN 
BEGIN ERROR! 34) ; TYPTR := NIL END ; 
iNSYMBOL ; EXPRESSION. ; 
IF GATTR. TYPTR -.= NIL THEN 

BEGIN IF GATTR. TYPTRa, FORM > SYMBOLIC THEN ERRORC35) ; 
IF LATTR, TYPTR ^= NIL THEN 
BEGIN PT := LATTR. TYPTR3.I NXTYPE ; 

IF {( GATTR. TYPTRa. FORM = SYMBOL! CM ( PTi. FORM = SYMBOLICnS 
(GATTR. TYPTR -.= PT> THEN ERR0R{36) ; 
WITH GATTR no 
IF KIND = SVAL THEN 

BEGIN IF ( LATTR. TYPTRa.LO > VAL) I (LATTR-TYPTRa.HI < VALI 
THEN ERROR 1 99) ; 
IT := VAL 
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1380. 
1381. 
1382. 
1383. 
1384. 
1385. 
1386. 
1387. 
1388. 
1389. 
1390. 
1391. 
1392. 
13'53. 
139'^. 
1395. 
1396. 
1397. 
1398. 
1399. 
1400. 
1401. 
1402. 
1403, 
1404. 
140 5. 
1406. 
1407. 
1408. 
1409. 
1410. 
1411. 
1412. 
1413. 
1414. 
1415. 
1416. 

1417. 
1418. 
1419. 
1420. 
1421. 
1422. 
1423. 
1424. 
1425. 
1426. 
1427. 
1428. 
1429. 
1430. 
1431. 
1432. 
1433. 
1434. 
1435. 
1436. 
143?. 
1438. 
1439 . 



:= CTERM 

:= END 



ELSE 



■IT, HI-IT, 0); 



"MR" 
«LR" 



END ELSE 

IF KINO = L7AL THEN IT 
BEGIN LOAD(GATTR) ; IT 
WITH LATTR, TYPTRS DO 
BEGIN XSIZE:=AeLTYPE3.SIZE; 

UPALIGN{XSIZE,AELTYPEa.ALIGN); 
DPLMT := DPLMT + (IT - LO)*XSIZE ; 
IF GATTR.KIND ^= SVAL THEN 

BEGIN IF INXCHECK THEN CHECKSNDSC STK( RP) ,L0 
IF XSIZE-.= 1 THEN 
IF OPTTYP = NOOPT THEN 
WITH XCONS DO 
BEGIn 

•^o^stkInO-.^integers; 
ivaluej=xsize; 

LDCST2(XC0NS,1) ; 
GENRR(#iC,0,STK(RP)) 
GENRRC#l8,STK(RP),l) 
END 
ELSE BEGIN 

IF EXPl -.= THEN GENRSI #89,STKI RP) ,0 tEXPl.O J ; 
IF OPTTYP ^= PURER THEN 
BEGIN GENRRt#18fO,STKlRPH ; ««LR" 

GENRSC#89,STKlRPi,0,EXP2,0l; "SLL" 
IF OPTTYP = POSP THEN GENRRC#1A,STKCRP) ,01 "AR" 

ELSE GENRR(#lB,STK{RPi,OJ; "SR** 
END 
END ; 

IF ACCESS = DRCT THEN ACCESS := INXD ELSe 
BEGIN RP := RP - 1 ; 

GENRRC#lAfSTK(RP),STK(RP+lH "AR" END 
END 

END ; 
END "IF LATTR, TYPTR -.= NIL" 
END «IF GAtTR. TYPTR -.= NIL" ; 

IF LATTR. TYPTR-.=NlL THEN LATTR, TYPTR:=LATTR.TyPTRa,AELTyPE ? 
UNTIL NO -t= 15 "t" ; 

IF NJ0=10 '*)» THEN INSYM80L ELSE ERROR (37) 
END "IF NO = 9" ELSE 
IF NO = 17 THEN "." 
BEGIN INSY^BQL ; 

IF NO = 1 THEN "ID" 

BEGIN IF L ATTR, TYPTR -.» NIL THEN 

BFGIN IF LATTR. TYPTR3.F0RH = RECORDS 
WITH LATTR 00 

BEGIN SRCHREC<TYPTR3.FSTFLDI ; 
IF CTPTR = NIL THEN 
BEGIN ERR0R(39) ; CTPTR 
WITH CTPTRS DO 
BEGIN TYpTr := FLD^'^PE 
AlIGivjhENT := ALIGN; 
IF BITWIDTH -.= THEN 
BEGIN 8IT4OR '= BITDISPl- 

PCkD := TRUE 
END ELSE PCKO := FALSe 
END 
END ELSE 

BEGIN ERR0RC38) ; LATTR. TYPTR := NIL 
END ? 
IN SYMBOL 



"SLL" 



THEN 



= UNOECPTR END ; 
OPLHt := DPLMir 4- 



m 
m 



fldaddr 



BITSZ := BItwIOtH 



END 
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1440, 
1441. 

1442. 
1443. 
1444. 
1445. 
1446. 
1447. 
1448. 
1449. 
1450. 
1451. 
1452. 
1453. 
1454. 
1455- 
1456. 
1457, 
1458. 
1459. 
1460. 
1461, 
1462. 
1463. 
1464, 
1465. 
1466. 
1467. 
1468. 
1469. 
1470. 
1471, 
1472. 
1473. 
1474- 
1475. 
1476, 
1477. 
1478- 
1479. 
1480- 
1481, 
1482. 
1483, 
1484- 
1485, 
1486, 
1487. 
1488, 
1489. 
1490, 
1491. 
1492. 
1493, 
1494. 
1495- 
1496. 
1497. 
1498. 
1499- 



EMD ELSE 

BEGIN ERR0RI41J ; LATTR.TYPtR := Nl L EnD 
END "IF NO = 17" ELSE "a" 
WITH LATTR DO 
8EG1N 

IF TYPTR -.= NIL THEN 

BEGIN LOADtLATTR) : ACCESS := INDRCT 
IF TYPTR3.F3R^1 = FILES THEN TYPTR : 
IF TYPTRa.FOR^ = POINTFR THEN TYPTR :=TYPTRa. ELTYPE 



DPLMT := ; 
TYPTRS-FELTYPE 



ELSE 



# 



ELSE TYPTR:=NIL 
END ; 

IF TYPTR-.= MIL THEN ALIGNMENT : = TYPTRa. ALIGN ELSE ERROR(40) 
INSYHBOL 
END "3" ; 
GATTR := LATTR 
END "VARIABLE" ? 



PROCEDURE FACTOR ; 

VAR LATTR, TaTTr : aTTr • LPTR • CTP ; LRP» LRRP 
At : ADDRESS; LPSVAl, I T2 : InTegER; 
XCONS : CONSTANT; LTcT,TcTx»LB6 »LB6A 
OP,REG: SHRTINT; 



shRtint 

ADDRESS; 



ELEMENT ; 

THE NEXT ELEHENT 



IN THE SET BEING ANALYSED" 



PROCEDURE 
"WORKS UP 
BEGIN 

EXPRESSION ; 

IF GATTR. TYPTR -t= NIL THEN 

IF GATTR. TYPTRi. FORM > SYMBOLIC THEN ERR0R(35I ELSE 

IF IGATTR. TYPTR = RE ALPTR) | CGATTR. TYPTR = ALFAPTRI THEN 

eRR0R{62l ELSE 

BEGIN IF LATTR. TYPTR -.= NIL THEN 

IF { (LATTR. TYPTRa. FORM -^= NUMERIC) MGATTR. TYPTRa. FORM -.= 
NUMERIC) )£(LATTR. TYPTR -= GATTR, TYPTR) THEN ERR0R(73) ; 
LATTR. TYPTR := GATTR. TYPTR ; 
IF GATTR, KIND = SVAL THEN I NSERTl I ,GATTR. VAL ,LPSVAL) ELSE 



• 






BEGIN LOAOt GATTR) ; GENRxC #41 , 0,1 ,0,0) 
GeNRS{#89,0,0,0,STkcRP) ) ; «»SlL« 
IF LATTR. KIND = SVaL TreN 
BEGIN GENRRi #18,STKIRP),0); "LR« 



"LA" 



;= LVaL ; LaTTR.CTERM 



GEnRR(#16,STK(RP),0); "OR" 



lattr,kind 

EMO ELSE 
BEGIN 

RP := Rp - 

END 
END 
END ; 
END "ELEMENT" ; 



BEGIN IF NO = 1 THEN 
BEGIN SEARCH ; 

IF CTPTR = NIL THEN 

BEGIN ERROR! 31) ; CTPTR ;= UNDECPTR END 
CASE CTPTR3,KLASS OF 
TYPES; BEGIN ERR0RI45) ; GATTr.jyPTR s 
KONST: wIth gaTTr, cTpTRa DO 

BEGIN TYPTR := CONTYPE ; 
IF CONKIND = ACTUAL TH£N 

i^iTh Values do 

CASE KDNSTKIND OF 



"IDENTIFIER" 



NIL ; iNsyMBOl E^O 



1500. IMTEGERSf SYMBOLICS: 

1501. IF IV4LI»E> = TW0T012 THEN 

1502. BEGIN LOCSKVALUES} ; KIND:=LVAL; CTERM: = END 

1503. ELSE BEGIN KIND:=SVAL; VAL:=IVALUE END; 

1504. REALSj 

ISOsI BEGIN LOCSTJVALUeS}? KIND:=LVAL; CTERM:=o EnD; 

1506. AlFAs: 

1507. BEGIN If" RP<ISTKLIh ThEN RP: = RP+l ELSe STKERR? 

1508. GENRX(#41,STK<RP) ,0,0,01 ; "LA" 

1509. GENCONSTC VALUES, IC-2); PCKD:=FALSE; 

1510. KlNn:=VARBL; ACCESS:=INDRCT; DPLMT:=0 

1511. ENDI 

1512. CHARS: 

1513. BEGIN KIND:=SVAL; VAL:=IVALUE END; 

1514. END "CASE KONSTKINO, WITH VALUES" 

1515. ELSE "FORMAL" 

1515. BEGIN KIND := VARBL ; ACCESS := ORCT ; 

1517. BREG := CLEVEL ; DPLMT := CADDR ; PCKD := FALSE ; 

1518. ALIGNMENT:=ALIGN 

1519. END ; 

1520. INSYMBOL 

1521. END ; 

1522. PROC : BEGI^J INSYMBOL ; 

1523. If (CTPTRi.PROCTYPE = NIL J ICCTPTRS. PROCTVPE = CT^TRJ THEN 

1524. BEGIN ERRr3R{46) ; GATTR.TYpTR := NIL END ELSE 

1525. IF NO ^= "5 THEN "|" 

1526. BEGIN ErroRC79> ; GaTTR-TYPTR := NIL END ELSe 

1527. IF CTPTRS.PReoEP tHeN "**INLINE FCF**" 

1528. BEGIN LPfR := CTPT^ ; INSYMBql ; EXPRESSION 5 

1529. IF GAITR.TYPTR -.= NIL THEN 

1530. CASE LPtRs.SEGSIZE QF 

1531. "ODD" I: BEGIN IF GATTR.TYPTRa.FORM -= NUMERIC THEN ERR0R{47) ; 

1532. LOADtGATTR) ; 

1533. GENRS(#89,STKIRP),0,3l,0) ; "SLL" 

1534. GENRS(#88,STKCRP)t0,3l,0J ; "SRL" 

1535. WITH GATTR DO 

1536. BEGIN TYPTR := BOOLPTR ; "KIND := LCOND ; JMP := 2 ; 

1537. ARITH := TRUE " KIND:=LVAL; CTERM:=0 

1538. END 
1539- END ; 

1540. "INT" 2: WITH GATTR DO 

1541. BEGIni IF TYPTfta.FORM>POWER ThEN ERR0RI44); 

1542. LOADIGAttR); KInD:=LVAL; CTERM:=0- TYpTR:=lNTpTR 

1543. HMD; 

1544. "CHR" 3: BEGIN IF GATTR.TYpTRa.pORM ^= NUMERIC THEN ERRq^UtI ; 

1545. IF ASSCHECK THEN 

1546. BEGIN LOADC GATTR) ; 

1547. WITH GATTR DO 

1548. BEGIN KIND := LVAL ; CTERM := END ; 

1549. CHECK8NDS{STKCRP),0,255,ASSERR) 

1550. END ; 

1551. GATTR. TYPTR := CHARPTR 

1552. END ; 

1553. "eof" 4: begin if gattr.typtra.form -.= files then error {44» ; 

1554. with gattr do 

1555. begin dplmt := dplmt + 1 ; loadjgattr) ; 

1556. typtr := boolptr ; kino := lcond ; jmp := 2 ; 

1557. arlth := true "what is happening???" 

1558. End 

1559. EHD ; 
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566. 
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,585. 
.586. 
.587. 
.588. 
.589. 
.590. 
.591. 

.592. 
L593. 
.594. 
.595. 
.596. 
.597. 
.598. 
.599. 
L600. 
L601. 
L602. 
.603. 
.604. 
.605. 
.606. 
.607. 
.608. 
.6^9. 
L610. 
1611. 
L612. 
L613. 
.614. 
L615. 
.616. 
1617. 
1618. 
.619. 



"A9S" 5: 



•»SQR'« 6! 



"TRC" 7 



»«PRE» 



8, 

9: 



BEGIN IF (GATTR.TYPTR -.= REALPTR) SiGATTR.TYPTRS.FORM -.= 

NUNERICJ THEN ERR0RI44) ; 

LOAD{GATTR> ; 

IF GATTR.T¥PTRa.ALIGN=8 THEN 

BEGIN OP := #20; "LPDR" REG i= RSTK(RRP) END 

El.se BEGIN OP := #10; "LPR" REG := STK(RP) END; 

GENRR(OP,REGtREGI ; 

WITH GATTR DO 

BEGIN IF TYPTR -= REALPTR THEN TYPTR := INTPTR ; 
KINO := LVAL ; CTERM := 

END 
END ; 
BEGIN IF (GATTr.TyPTr -,= REALPtR)€«GATTR-TYPt'^3.F0RM -»= 

NUMERIC) Then ERR0R(4^4) ; 

LOAD (GATTR I 1 

WITH GATTR DO 

BEGIN IF TYPTR = REaLPTR THEN 

GENRR(#2C»RSTKCRRP} iRSTKfRRP}) "MDR" 






ELSE BEGIN G6nRRI#18, I ,STK<RPn 
GENRR(#lC,0,STK(RPn 
GENRRI#18,STKCRPJ,l) 
TYPTR := INTPTR END; 



"LR" 
"MR" 

"LR" 



KIND := LVAL ; CTERM :« ; 

END 
END ; 
BEGIN IF GATTR.TYPTR -.= REALPTR THEN ERR0RI44) 

LOAO(GATTRJ ; 

FLOATTQFIXED; 

WITH GATTR 00 

BEGIN TYPtR i- 
EtsiO ; 



INTPTR ; KIND := LVAL ; CTERM := END 



IP <G&TTR«TYPTRa.FORM > 
REALPTrHCGATTR. TYPTR = 



SYH80LIC) ICGATTR. TYPTR ' 
ALfAPTRI THEN 



GATTr,Typtr 



NIL END ELSE 



= MAX END ELSE 
FCONSTa. VALUES. I VALUE 



BEGIN ERR0RC44) ; 
BEGIN LOADIGATTRI ; 
WITH GATTR. TYPTRa DO 
IF FORM = NUMERIC THEN 
BEGIN ITl := MIN ; rT2 
BEGIN ITl :=» ; I T2 : = 
IT := LPTRa.SEGSIZE ; 

IF rT=8 THEN GENRR{#06fSTKIRP) ,0) "8CTR" 
ELSE BEGIN GENRX(#41,0fl, 0,0) ; "LA" 

GENRRCilAtSTKtRP) ,0) "AR" END; 
IF ASSCHECKCIGATTR. TYPTR -.= INTPTRl THEN 
CHECKSN0SlSTK(RP),lTl,lT2,ASSERR} ; 
WITH GATTR 00 

BEGIN KIND := LVAl ; CTErm := END 
END 
END iiCAsE L^T^a-SEGsIzE 0^" ; 
IF NO -»= 10 THEN ")» 
BEGIm ERR0RC48) ; GATTR. TYpTR 
END "IF CTPTRa.PREDEF" ELSE 
WITH TATTR,RXAOOR DO 
BEGIN LTCT:=TCT; LRRP:=RRP; 
IF RRP>0 THEN 
BEGIN UPALIGNITCT,8) ; 

KIND:=VAR8L; ACCESS:=0RCT; 
PCKD:=FALSE; ALIGNMENTs-S; 
DPLMT:=TCT; 



END 



:= NIL 



END ELSE INSYMBOl 
•'♦♦EXTERNAL FCT**" 



BREG:=LEVeL; 
TYPTR: -REALPTR: 



1620- 
1621. 
1622. 
1623. 
1624. 
1625. 
1626. 
1627. 
162fi. 
1629. 
1630. 
1631. 
1632. 
1633. 
1634, 
1635. 
1636. 
1637. 
1638. 
1639. 
1640. 
1641. 
1642. 
1643. 
1644. 
1645. 
1646. 
1647. 
1648. 
1649. 
1650. 
1651. 
1652. 
1653. 
1654. 
1655. 

1656. 
1657. 

1658. 
1659. 
1660. 
1661. 
1662. 
1663. 
1664. 
1665. 
1666 » 
1667. 
1668. 
1669. 
1670. 
1671. 
1672. 
1673. 
1674. 
167 5. 
1676. 
1677. 
1678 . 
1679. 



FOR IT := 1 TO LRRP DO 

BEGIN 

store(tattr> ; 

TCT := TCT + 8; IF TcT > TmAX THEN TMAX := TCT 
DPLHT:=TCT; 

end; 

TCTX:=DPLMT; 
EMO; 

LB6:=B60PL; 
IF L86-.= 72 THEN 
WITH XCONS DO 
BEGIN 

K0NSTKIND:=INTEGERS; 

L86A:=LB6; UPALIGNaB6A,8| j 

IVALUE: = L86A; LOCSTCXCONSr; 

GENRR{#IA,2,STK(RP1 } "AR" 
END; 

LRP := RP ; •» LPTR := CTPTR3. PROCTYPE ; " 
RRP := ? "RESTRIGTS # OF NESTeo FUNCTION CALLS'* 
"BECAUSE It Lt^V^S LB^ft ^N STK{RP)" 
PASSPARAMS ; 
RRP:=0; RP := LRP ; 
IF lb6-,=72 Then 

BEGIN GENRR<#18,2,STKrRPl J ; "SR" RP:=RP-1 END? 
86DPL:=LB6; 

IF LRRP -'= THEN 
BEGIN 

0PLNT:-TCTX*. 

FOR IT := LRRP DOWNTO I DO 
BEGIN DPLMT:=DPLMT-8; 

LOAD(TATTR»; 
END; 
END; 

TCT:=LTCT; 
» KITH GATTR 00 

BEGIN TYpTr := LPTR ' KiNQ := LvAl ; CtERm := £nD < 
END 
END ; 

vars , 

field : variable ; 

END "CASE CTpTRS.KLASS 0F« ; 
END "IF NQ = 1»» ELSE 
IF NO = 2 THEN 
BEGIN WITH GATTR, XCONS 00 

CASE CL OF 



m 
m 
m 






"CONSTANT** 



# 



1 



BEGIN TYPTR := INTPTR ; 

IF ABSdVALI >= TW0T012 THEN 
BEGIN KONSTKIND := INTEGERS 
I VALUE := IVAL ; 
LDCST( XCONS* ; 
KIND := LVAL ; CTERM := 



3: 



ELSE BEGIN KIND := SVAL 

e^d; 

begin typtr := realptr ; 

KONSTKINO := REALS ; 

RVALUE := RVaL ; 

LOCST< XCONS) ; 

rINO := LVAL ; CTfiRM := 
END; 
BEGIN TYPTR := ALFAPTR ♦ 



VAL 



END 

:= I VAL 



END; 






m 



1680. 
1681. 
1682. 
1683. 
1684, 
1685, 
1686. 
1687. 
1688. 
1689. 
1690. 
1691. 
1692. 
169.3. 
1694, 
1695. 
1696. 
1697. 
1698, 
1699. 
1700. 
1701, 
1702, 
1703, 
1704, 
1705. 
1706. 
1707. 
1708, 
1709. 
1710, 
1711. 
1712, 
1713, 
1714, 
1715, 
1716. 
1717. 
1718. 
1719. 
1720. 
1721. 
1722. 
1723. 

1724. 
1725. 

1726, 
1727. 

1728. 
1729. 
1730. 
1731. 
1732, 
1733, 
1734. 
1735, 
1736. 
1737. 
1738. 
1739, 



IF RP<ISTKLIM THEN RP:=RP*1 ELSE STKERR 



GENRX ( #4 1,STK{RP 1,0,0,0) 



'LA' 



00 
NILPTR 



FACTOR 



KIND := SVAL 



«NIL« 



VAL := NILVAL.IVALUe END 



It -, M 



KONSTKINDt^ALFAS; A VALUE :=A VAL; 
GENC0NSTCXCONS,IC-2) ; PCKD:=FALSE; 
KIND:=VAR8L; ACCeSS:=I NORCT; DPLMT:=0 

emd; 

^: BEGIN TYpTR := CHARP^R ; 
kIn^^ := SVAL ; 
VAL := INTiCHVAL) I 
EmO; 

END ; 

INSYM80L ; 
EMD "IF NO = 2" ELSE 

IF NO = 36 THEN 
BEGIN WITH GATTR 
BEGIN TYPTR := 
INSYM80L 
END ELSE 
IF NO = 5 THEN 
BEGIN INSYMBOL ; 
WITH GATTR DO 
IF TYPTR -.= NIL THEN 
If TYPTR = BOOLPIR THEN 
BEGIN 

I OA^^C GftTTR i ; 
GENRx(#4l, 0,1,0,01 ; »»LA" 
GENRR<#17,STK(RP),0) ; "XR" 
KIND := LVAL ; CTeRM := ; 
END ELSE ERR0R(50) 
END "IF NO = 5« ELSE 
IF NO = 9 THEN 

BEGIN INSYiMSOL ; EXPRESSION ; 
IF MO -.= 10 THEN ")" 

BEGIN FRR0RC48) ; GATTR, TYPTR := NIL END ELSE INSYMBOL 
END ELSE 
IF NO = 11 THEN 
BEGIN INSYMBOL ; 
IF NO = 9 THEN 
BEGIN INSYMBOL ? 

IF NO == 10 THEN ")" 

WITH GATTR DO 

BEGIN TYPTR := LAmPTR 

VAL := O ; INSYMBOL 
END ELSE 
BEGIN WITH L^TTR DQ 

BEGIN TypTr := NIL ; KIND 

elFmEnt ; 

while no = 15 do »'," 

BEGIN INSYMBOL ; ElEmEnT END ; 

IF LPSVAL ^= THEN 

IF LPSVAL >= TW0T012 THEN 

BEGIN XCONS.KONSTKIND := INTEGERS ; 

XCONS.IVALUE i= LPSVAL ; 

LDCST(XCQNS) ; 

IF LATTR.KIND = LVAL THEN 

BEGIN RP:=RP-1 ; GENRR( il6,STK{RP) ,STKi RP+ll ) 

LATTR,KIN0 := LVAL ; LATTR. CTERM := 
END ELSE 

IF LATTR.KIND = SVAL THEN LATTR. VAL := LPSVAL ELSE 
BEGIN GENRX(#41»0»tPsvAL,o,OI I «LA« 



m 
m 



SET 



KIND := SVAL 



SVAL END ; LPSVAl 



m 
m 
m 



"0R« END ELSE 



# 



1740. 
1741. 
1742. 
1743. 
1744. 
1745. 
1746. 
1747. 
1748- 
1749. 
1750. 
1751. 
1752. 
1753. 
1754. 
1755. 
1756. 
1757. 
1758. 
1759. 
1760. 
1761. 
1762. 
1763. 
1764. 
1765. 
1766. 
1767. 
1768. 
1769. 
1770. 
1771. 
1772. 
1773. 
1774. 
1775. 
1776. 
1777. 
1778. 
1779. 
1780. 
1781. 
1782, 
1783. 
1784. 
1785. 
1786. 
1787. 
1788. 
1789. 

1790. 
1791. 
1792. 
1793. 
1794. 
1795. 
1796. 
1797- 
179S. 
1799. 



GENRR{#l6,STK(ftP),0» "OR" END ; 
IF LATTR.TYPTR -.= NIL THEN 

IF LATTR.TYPTRa.FORM = NUMERIC THEN LATTR.TYPTR := 
ELSF LATTR.TYPTR := LATTR. TYPTRa.PWSET ; 
IF NO -.= 10 THEN ••)" 



PNUMPTR 






ERR0RI37) 
:= LATTR 



LATTR.TYPTR := NIL END ELSE INSYMBOL 



:= NIL END 



LATtR.KIND:=LVAL; 
FACTOR; 



BEGIN 
GATTR 
END ; 
END "IF NO = 9« ELSE 
BEGIN ERROR (42) ; GATTR. TYPTR 
EMD "IF NO = li» ELSE 
BEGIN ERR0R(42) ? GATTr. TYPTR := NIL END 

EnO «f actor " ; 

PROCEDURE Term ; 

VAR LATTR : ATTRj BT1,8T2»BT3,BT4 : BOOLEAN ; 

LMOPCLfOPC : ShrTinT ; 
PROCEDURE CHECKDIVIFRP : RGB M 

BEGIN IF GATTR. KIND = SVAL THEN 

BEGIN IF GATTR, VAL = THEN ERftOR!l02l; 
END ELSE 

IF DIVCHECK THEN 

BEGIN " JUMP ZKRODIVIOE " END; 
END "OIVCHECK"; 

BEGIN FACTOR; 

IF NO = 6 THEN "MULOP" 
BEGIN 

LOADCGATTRj; 

LATTR.TYPTR: =GATTR.TYpTR; 

LAttR.CtERM:=o; 
REPEAT LMO''CL:=Cl; InSYMBOL; 

IF {lattR,typtr-.=nIl)s{Gattr.typtr^=nil) Then 

BEGIN IF LMOPCL = 3 THEN "S« 
BEGIN LOADCGaTTr); Rp:=RP-l; 

If (LATTR, TYPTR=GATTR.TYpTR)S(CLATTR.TYPTR3.F0RM=P0wERM 

(LATTR.TYPtR=800LPTR)J THEn 

GENRR(#14,STK(RP|,STKrRP+in ELSE ERROR{50I 
END ELSE 
BEGIN 

BTl:=LATTR.TYPTRS.FORH=NUHERIG; 

BT2: = GATTR.TYPTRa.F.0RM=NUMERIC; 

BT3:*LATTR.TyPTR=REALPTR; 

BT4:=GATTR.TYPTR=REALPTR; 

IF C8T1&BT4) |(8T2g8T3] THEN "MIXED EXPRESSIONS " ERRORCSOI 

IF (8T3SBT4) THEN 
BEGIN LOADCGATTR}; 

If lmopcl=i Then opc:=44 elSe 

IP LM0PCL=2 Then 0PC:=45 ELSE ERROR<50); 
RRP:=RRP-1; 

GENRRCOPCtRSTKCRRPJ f RSTKCRRP*U ) 
END 
ELSE 
BEGIN 

IF (BTlg8T2l THEN 
BEGIN LOAOCGATTRI; 

IF LMOPCL = I THEN " * " 

BEGIN 0PC:=28; GENRRC #18, I , STK(RP-iJ I END 
ELSE " / DIV MOO " 



m 

m 



■vimim'miitmm 



• 






m 
m 
m 



# 
m 



1800. 


BEGIN 0PC:=29; 


1801. 


GENRR(#18,0,STK(RP-1)) ; 


1802. 


GENRS(#8EtO»0,32»0) 


1803. 


END; 


1804. 


GENRR<OPC,#0,STK(RPn ; RP:=RP-l; 


1805. 


CASE LMOPCL OF 


1806. 


"*" l: BEGIN 


1807. 


" CHECK FOR OVERFLOW " 


1808. 


GENRR(#18,STK(RP),#1); 


1809. 


END; 


1810. 


'•/ OIV " 2f4: GENRR(#l8,STK(RP),#l) ; 


1811. 


"MOD" 5: GENRR(#18»STKCRP!f#0) 


1812. 


END 


1813. 


END ELSE ERR0R{50) 


1314. 


END 


1815. 


END 


1816. 


END 


1817. 


UNTIL N0-.=6; 


1813. 


GATTR:=LATTR; 


1819. 


END "IF NO = ^ » 


1820. 


END "lER^"; 


1821. 




1822. 


PROCEDURE SINPLEEXP; 


1823. 


yAR LATTR : ATTR ; LAOOPCL : ShRTINT ; tFGtBTl»BT2 : BOOLEAN; 


1824. 


BEGIN 


1825. 


lfg:=false; 


1826. 


IF N0=7 THEN «ADDQP»» 


1827. 


BEGIN 


1328. 


IF CL = 2 THEN LFG: = TRUE ELSE IF CL = 3 THEN ERR0R{5U; 


1829. 


INSYN90L 


1830. 


END; 


1831. 


TERM; 


1832. 


IF LFGI{N3=7} THEN 


1833. 


BEGIN WITH LATTR DO 


1834, 


BEGIN 


1835. 


TYPTR:-GATTR,TYPTR; KIND:=LVAL; CTERM:«D; 


1836. 


IF TYpTR^«NiL Then 


1837. 


BEGIN LQA^'SAtTr); 


1838. 


IF LFG THEN 


1839. 


BEGIN 


1840. 


IF TYPTR3.F0RM = NUMERIC THEN GENRRt #l3f STKCRP},STk:CRPH 


1841, 


ELSE IF TYPTR=REALPTR THEN GENRRC #23,RSTKCRRP) ,RSTK( RRP) ) 


1842, 


ELSE ERR0R{50); 


1843. 


END 


1844. 


END 


1845. 


END; o 


1846. 


WHILE Na=7 DO 


1847. 


BEGIN LADQPCL:=CL; INSYMBOL; TERM; 


1848, 


IF RATTR.TYPTR-.=NIL)S{GATTR,TYPTR-i=NILl THEN 


1849. 


BEGIN BT1:=LATTR,TYPTR3,F0RH=NUMERIG; 


1350, 


BT2:=GATTR,TYPTRa.F0RM=NUMERIG; 


1851, 


IF 8T1S8T2S{GATTR.KIN0=SVALI THEN 


1852, 


BEGIN WITH LATTR DO 


1853, 


BEGIN TYPTR:=INTPTR; 


1854, 


CASE LADOPCL OF 


1855. 


M+« 1: CtERH.=CtERm+GATTr,VAl; 


1856. 


"-" 2: CTeRM:=CTERM-GATTR.VAL; 


1857. 


3: Error (50 J 


1858, 


END 


1859. 


END 



m 
m 



1860. 
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1862. 
1863. 
1864, 
1365. 
1866. 
1867- 
1868. 
1869. 

1870. 
I87l, 

1872. 
1873. 
1874. 
1875. 
1876. 
1877. 

187 8, 
1879, 
1880. 
1881. 
1882. 

188 3. 
1884. 
1885. 

1886. 
1887, 
1888. 
1889. 
1890. 
1891. 
1892, 
1893. 
1894, 
1895. 
1896, 
1897- 
1898. 
1899. 
1 900. 

190 I . 
1902. 
1903. 
1904. 
1905. 
1906. 
1907, 
1908. 
1909. 
1910. 
1911. 
1912. 
1913. 
1914. 
1915. 
1916, 
1917, 
1918. 
1919. 
1920. 



END ELSE 

6EGIM LOAD(GATTR); 
IF flTlSBT2 THEN 

BEGIN LATTR.TYPTR:=INTPTR; RP:=RP-l; 
CASE LADOPCL OF 
l: GFNRR(#lA,STK(RP),STKlRP+l) ) ; 
2: GENRR( ^IBfSTKiRP) tSTKCRP+1) } ; 
3: ERR0R(50j 

END 
END ELSE 

IF (LATTR.TYPTR=REALPTR)&{GATTR.TYPTR=REALPTRi THEN 
BEGIN 

RRP:=RRP-i; - 
CASE LADOPCL OF 
I: GENRR{#2A,RSTK(RRP) ,RSTK(RRP*-l) ) ; 
2: GENRR(#2B»RSTK(RRP)tRSTK(RRP+l)) ; 
3: ERR0R{50) 
END 
END ELSE 

IF LATTR.TYPTR=GATTR.TYPTR THEN 
BEGIN RP:=RP-l; 

IF rLATTR,TYPTR=B00LPTR)S<LA00PCL=3} THEN 
GENRR{#16,STK(RP),STKlRP+l) ) ELSE 
IF LATTR,TYPTR3,F0RM = POWER THEN 
CASE lADopCl oP 
1: BEGIN 

GENRRI#17»STK(RP+i) »st'<«RP) J; 
GeNRRC#14,STK(RP} ,STK(RP-i-1)) 
END; 
2: ERR0R(50); 
3: GENRR ( #16 , STK ( RP ) , STK <RP + 1 1 } 

END 
END ELSE ERR0R(50) 
END 
END 
END "WHILE N0=7 " ; 
GATTR:=LATTR1 
END "IF LFGMN0=7)'* 
END "SIMPLEEXP'»; 

PROCEDURE EXPRESSION; 

VAR LATTR:ATTR; L0FfBTl,8T2: BOOLEAN? 

XSiZE: INTEGER; 

LREL0PCL,OP,RREGlfRRE62»Dl,Rl,O2,R2fATfAT2fSAVERP, 
MASK, COUNT, LCST: INTEGER; 



• 

m 



BEGIN 
SAVERP 
SIMPLE 
IF N0 = 

. BEGI 

IF 



:=RP; AT2:=0; 
EXP; 

8 THEN " RELOP " 

N lattr:=gattr; lof:=true; 

LATTR.TYPTR-i=NIL THEN 
IF<LATTR.TYPTR3.F0RM>=ARRAYS) HLATTR.TYPTR=ALFAPTR| THEN 
BEGIN GENSAODRILATTRI; 

Ol:=SSAO0R.02; R1:=SSAD0R. 62 ; RP:=RP*1; 
END 
ELSE IFUATTR.KIND=SVAL)S(CCL=7) M < LATTR, VAL=0J £ 
(LATTR,TYPTR-.=BOOLPTRin THEN 
BEGIN LOF:=FALSE; LCST:=LATTR. VAL; 

IF CL<=4 THEN CLJ=5-CL; 
END 



r ■ 


1921. 


I, ^ 


1922. 




1923. 




1924, 




1925. 


w 


1926. 




1927. 




1928. 




1929. 




1930. 




1931. 




1932. 




1933. 


' 


1934. 




1935, 




1936, 


^ 


1937. 




1938. 


(" 


1939. 




1940. 




1941. 




1942. 




1943. 




1944. 




1945. 




1946. 




1947. 




1948. 




1949. 




1950. 


r 


1951. 




1952. 




1953. 




1954. 




1955. 




1956. 




1957. 




1958. 


1959. 




1960. 




1961. 


1962. 




1963. 




1964. 


1965. 




1966. 


€1 


1967. 


1968. 




1969. 




1970, 


1971. 




1972. 




1973. 


1974. 




1975. 




1976. 


1977, 




1978, 


m 


1979. 


1980. 



ELSE LOAOtLATTRJ; 
LRELGPCL:=Cl.t INSYM80L; SIMPLEEXP; 
IF lLATTR.TYPTR-.=NIL)&(GATTR.TYPTR-.=NILi THEN 

BEGIN IF(GATTR.TYPTRa.FORM>=ARRAyS) I ( GATTR.TYPTR=ALF APTR) 
BEGIN GEINISADDR(GATTR); 

D2:=SSADDR.D2; R2:=SSAD0R.B2 ; 



THEN 



END 
ELSE 

THEN 
ELSE 



IF(GATTR.KIND = SVAL)S(GATTR.VAL= 
(GATTR.TYPTR-.= BOOLPTR)eLOF 
L0F:=FALSE 
LOADCGATTR) ; 



=0)5 






IF LREL0PCL=s7 then « iN « 

BEGIN IF(GATTR.TYPTR3,FaRM=P0WeR|£ 

CGATTR.TYPTRa.ELSET=LATTR.TYPTR| 
f (GATTR.TYPTR = PNUMPTRJSILATTr,TYPTR3.F0RM=NuS*^ERIC) 
THEN BEGIN IF LOF THEN 

BEGIN GENRS(#88,STK(RP} ,0,0,STK|RP-1II; '» SRt " 
G6NRX(#41,STK(RP-1) ,ltO.O); " LA « 
GENRRI#14»STK<RP-1} ,STK(RP|); " NR « 
RP-=RP-l. 

END 

ELSE BEGIN GENRSi 137,STKCRP) ,31-LCST,0,0) ; "SLL" 

GENRSC#88,STK<RP), 31,0,0)? » SRL » 
END 
END ELSE ERR0RC50); 
END" LREL0PCL=7 " 
ELSE BEGIN BTl:=LATTR. TYPTRa.FORM=NUMERIC ; 
BT2:=GATTR.TYPTRa.FDRM=NUMERlC; 
IF BTl£(GATTR.TYPTR=REALPTRJTHEN 
BEGIN IF LOF THEN FI XEOTOFLOAT; 

IF LREL0PCL<=4 THEN LREL0PCL:=5-LREL0PCL; 
LATTR.TYPTR:=REALPTR; 
EmD; 
IF 8T2f.(LATTR,TYpTR=REALPTR) THEN 

begin if lof then fi xedtofloat; 
gattr.typtr:=realptr; 

END; 
IF(BTl£3T2i MLATTR.TYPTR=GATTR,TyPTR) € 

ILATTR.TYPTRa.FORM<=POINTERJfiILATTR.TYPTR-.= ALFAPTR) 
|(LATTR.TYPTRS.FORM=POINTeR)£CGATTR.TYPTR=NILPTR) 
1 tGATTR.TYPTRa.FORM=POINTER)S<LATTR.TYPTR=NILPTR| 
THEN BEGIN 

IF LATTr.tYPTR=REALPTR THEN 
IF LOF THEN 

BEGIN 0P: = #29; '* COR »• 



m 



m 
m 



RReG2:=RSTKCRRP) 
RRP:=RRP-2; 

END 
ELSE BEGIN 0P:=#22; 
RREG2:=RSTK(RRPJ 

RRP:=RRP-1; 
END 
ELSE IF LOF THEN 
BEGIN 0P:=#19; 
RREG2:=STKCRP) ] 
RP:=RP-2; 
END 
ELSE BEGIN 0P:=#12i 
RREG2:=STK(RP) i 



RREGl:»RSTK(8RP-U 



• LTDR « 
RREG1:=rstkCRRPJ 



CR " 
RREGl:=STK<RP-l) 



LTR " 
RREGi:=STKIRP| 



RP:=RP-1' 
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1981. 

1982. 
1983. 

1985. 
1986. 
19S7. 
1938. 
1989. 
1990. 
1991. 
1992. 
1993. 
1994. 
1995. 
1996. 
1997. 
1998. 
1999, 
2000. 
2001. 
2002. 
2003. 
2004, 
200 5. 
2006. 
2007, 
2008. 
2009. 
2010. 
2011. 
2012. 
2013. 
2014. 
2015. 
2016. 
2017. 
2018. 
2019. 
2020. 
2021. 
2022. 
2023. 
2024. 
2025. 
2026. 
2027. 
2028. 
2029. 
2030. 
2031. 
2032. 
2033. 
2034. 
2035. 
2036. 
2037. 
2038. 
2039. 
2040. 



END 
ENO " IF(BTl£BT2) I... " 
ELSE IF {LATTR.TYPTRa,FORM=POWER)£ 

(GATTR.TYPTRS).FORM=POWER) THEN 
IP(LATTR«TYPTR=GATTR.TYpTR} | I LATTr,TyPTR=LAMPtR ) 
|{GATTR.TYPTR=LAMPTR) THEN 
3EGIM IF(LREL0PCL=1) HLREL0PCL=4ITHEN ERROR(88) 

ELSE IF LREL0PCL>=5 THEN IF LOF THEN 0P:=#19 "CR " 

ELSE 0P:=#12 "LTR " 
ELSE IF -.LOF THEN ERR0R(89) 
ELSE BEGIN 0P: = #14; «• NR « 
IF LREL0PCL=2 THEN 

BEGIN RREG2:=STK(RP| ; RREGl :=STK1 RP-1 ) ; END 
ELSE BEGIN RREG2 :=STK(RP-l J ; RREGl ;=STK( RP) ; END; 
GE'^RRC#13,RREG2,RREG2) ; » LCR " 
GENRR{#6,RReG2,0); » BCTR •♦ 
LREL0PCL:=6; 
END; 

IF LOF THEN RP:=RP-2 ELSE RP:=RP-l; 
END; " POWERSETS " 
MASK:=MASKARRAY<LRELOPCLi ; 
EMD; "BTl:=LATTR.TYPTRa.FORM=NUMERlC" 
IF LATTR.TYPTR3.F0RM>=CLASSS THEN ERRQR150) 
ELSE IF(GATTR.TYPTR=LATTR.TYPTR)£ 

I (LATTR.TYPTRa.FORM>=ARRAYSl j (LATTR.TYPTR=AlFAPTRn 
THEN BEGIN XSI ZE :=LATTR, TYPTRS. Sl ZE J 
C0UNT:=IXSIZE-1) DIV 256; 
IF COUNT>0 THEN 

BEGIN XSIZE:=XSIZE MOD 256; 

GENRX{*41,0,C0UNT,0,0) ; « LA « 
AT:=IG; 

GENSS(fD5,Dl,255«Rl,02»R2J; " CLC " 
GENRX< #47,15-MASK,0f 0,0J ; AT2:=ie~2; 
GENRXr#41,Rl,25&,0,RU ; 
GENRXI #41, R2, 256,0, R2) ; 
GeMRX(#46, 0,0,0, 01 ; " 8CT " 
INS{AT,IC-2U 
END; 
GEMSS(#05,D1,XSIZE-1»R1»D2»R2I ; 
RP:=SAVERP; 
END 
ELSE GENRR(0P,RREGl,RREG2l ; " SPECIFIC TEST •• 

IF LREL0PCL-.= 7 THEN 

BEGIM IF RP<ISTKLIM THEN RP:=RP-H ELSE STKERR; 
GENRX(#4l,STK{RP),l,0,0l; « LA - TRUE »» 
GENRXr#47,MASK, 0,0,0); " BRANCH IF TRUE «» 
AT:=IC-2; 

IF AT2-.= THEN INS(IG,AT2J; •• FIX 
GENRR{27,STK<RP),STKIRPn; " SR - 
INSCICATi; " JUMPS HERE IF TRUE 
END 
END; " TYPTRS - NIL " 
LATTR.TyPTR:=BOOLPTR; LATTR. KI ND: =LVAL; LATTR.CTERM: =0; 
GATTR:=LATTR; 
END " IF NO: =8 " 
END "EXPRESSION"; 



m 

m 



LOOP EXIT 
FALSE w 



• 
• 



PROCeOURE PASSPARAMS; 

VAR LPL,LPC,LDSP,!T2,LPA,RPSAVE,RRPSAVE,LTCT; 



INTEGER; 



m 

m 



2041. 
2042. 
2043. 
2044. 
2045. 
2046. 
2047- 
2048- 
2049. 
2050. 
2051. 
2052. 
2053. 
2054. 
2055. 
2056. 
2057. 
2058. 
2059. 
2060. 
2061. 
2062. 
2063. 
2064. 
2065. 
2066, 
2067. 
2068. 
2069. 
2070. 
2071. 
207 2. 
2073. 
2074. 
2075. 
2076. 
2077. 
2078. 
2079. 
2080. 
2081. 
2082. 
2083. 
2084. 
2035, 
2086. 
2087. 
2088- 
2089. 
2090. 
2091. 
2092. 
209 3. 
2094. 
2095. 
2096. 
2097. 
2098. 
2099. 
2100. 



LPK»BT: BOOLEAN; TP:CTP; ISIZE UNTEGER; 
LFPtCTP; TATTR:ATTR; XC0NS:C0NSTANT ; 
8EGIN 

LPL:=CTPTR3).PR0CLEVEL; LFP:=CTPTRa).FORHALS; 

LPK: = CTPTR5).PR0CK I N0= ACTUAL; 

XC0NS.K0NSTKIN0:=EXTREF; XCONS. E VALUE : =CTPTRa.SDNAMe ; 



RRPSAVE:=RRP; 
FUNCTION " 



tattr,kind:=varbl; 

i^LEVEL; 



LDSP:=72; LPC:=0; RPSAVE:=RP; RRPSAvE:=RRP; LTCT:=TCT; 
IF CTPTRa.PROCTYPE^=cTpTR THEN " 
BEGIN TP:=CTPTRi.PROCTypE; 

tJPALlGNlTCT,TPa. ALIGN! ; 

TATTR.ALIGmMENT:=TP9.ALIGN; 

TATTR.TYPTR:=TP; TATTR.8REG; 

TATTR.DPLMT:=TCT; TATTR. ACCESS:«0RCT; TATTR.PCKD:=FALSE; 

IT2:=TCT; TCT:=TC T+TPS.SI ZE ; IF TCT>TMAX THEN TMAX:=TCT; 

LOAOAORiTATTR) ; TATTR.DPLMT J=I T2 ; TATTR. ACCESS:=DRCT ; 

GENRXC#50»STK(RPJ,72tO,2) ; " ST « 

rp:=rpsave; 

L0SP:=76; 

END; 

IF N0=9 THEN " ! »• 
BEGIN 
REPEAT 

IF LFP=NIL THEN 

BEGIN IF LPK THEN 

BEGIN ERR0Ra2}; SKIP<49I; GOTO 1; END; 
8T:=FALSE; 
END 
ELSE BT:=LFPa.KLASS=PROC; 

insy^^bol; 

IF 8T THEN •♦ PROC FCT TO BE PASSED « 
BEGIN " NOT IMPLEMENTED " 

ERROR til); insymbol; 

END 
ELSE •• EXPRESSION TO BE PASSED « 
BEGIN B60PL:=L0SP; EXPRESSION; 
IF GATTR.TYPTR-.=NIL THEN 
BEGIN IF LPK THEN 

BEGIN IF(LFPa.KLASS=KONST) ULFP3.VKIND=ACTUAL| THEN 
BEGIN IF GATTR.TYPTR-^ALFAPTR THEN LOADIGATTR) 
ELSE GENSADDRIGATTRl; 
IF LFPa.KLASS=KONST THEN 

BEGIN PT:=LFPa.CONTYPE; LDSP*=LFPS.CADDR; £N0 
ELSE BEGIN PT:=LFP3. VTYPE ; LDSP:=LFP3.VADDR END; 
IE|GATTR-TYPTRa.FORM=NUMERIGKiPT=REALPTR} THEN 
BEGIN FIXEOTOFLOAT; 

gattr.typtr:=realptr; 

EnO 
END 
ELSE BEGIN 

IF GATTR.KIND=VAR8L THEN iOADADRf GATTRI 

ELSE ERR0R{86}; 

PT:=LFP3.VTYPE; 

LDSP?=LFPa.VADDR; 

if pt-.=nil then 
if gattr.typtr3,size-.=pt3.size then 
error(60); 

END; 

IF PT-.=NIL THEN 

IF GATTR.TypTR-.=pT TheN 

lP(GATTR.TYPTRa.FORM-.=NUMERIG) I 



• 



2101. (PT3.F0RM^=NUMERIGJ THEN 

2102. IF{GATTR.TYPTR-.=NILPTR) | 

2103. {PTa.FORM-.=POINTER) THEN 

2104. IFiGATTR.TYPTR-.=LAMPTR) I 

2105. (PTS.FORM-^POWER) THEN 

2106. ERROR(60l; 

2107. END •• IF LPK " 

2103. ELSE BEGIN » FORMAL PROCEDURE STUFF " 

2109. END 

2110. END '» IF GATTR.TYPTR-.: = NIL " 

2111. END; " EXPRESSION TO BE PASSED « 

2112. '» STDRE INTO PARAMETER AREA " 

2113. IF LPK THEN 

2114. BEGIN ISIZE:=PTa.SlZE; 

2115. IF(LFP3.KLASS=K0NST) 1(LFP3.VKIND=ACTUAL) THEN 

2116. IF GATTR.TYpTR=ALFAPTR THEN « MvC •• 

2117. GE(MSS<#D2,L^SPt9,2,SSAD0R.D2fSSADDR.B2) 
211B. ELSE IF 1SIZE=2 THEN « STH " 

2119. GEnRX(#40,STK(RP),LDSP,0,2J 

2120. ELSE IF ISIZE=l THEN " STC « 

2121. GENRX(#42»STKCRP),LDSPfO,2) 

2122. ELSE IF ISIZE=8 THEN •» STO " 

2123. GENRXC#60,RSTKtRRP) ,LDSP,0,2} 

2124. ELSE GENRX(#50,STK<RP>,LDSP,0,2} " ST " 

2125. ELSE BEGIN GENRXf #50,STK(RP) ,LDSP,0,2 ) ; « ST " 

2126. ISIZE:=4; END; 

2127. LDSP:=LDSP+ISIZE; LFP: =LFPa. NXTEL; 

2128. END 

2129. ELSE BEGIN " NOT LPK •» END; 

2130. LPC:=LPC+1; RP:=RPSAVE; RRP:*RRPSAVE; 

2131. UNTIL N3-. = l5; 

2132. If MO-»=lO THEN " I « 

2133. BEGIN ERRORf^B); SKIPI49I; END 

2134. ELSE INSyMBOL; 

2135. EMD; " IF N0:=9 " 

2136. IF LFP-.=NIL THEN ERR0RI72I; 

2137. IF LPK THEN 

2138. 8EGIM IF LPL=LEVEL THEN GENRX< #50f 13 tOt 0,2) " ST " 

2139. ELSE IF LPL=LEVEL-l THEN GENSSt #02,0,3 ,2,0, 13 ) " MVC " 
2140* ELSE IF LPL<LEVEL-l THEN 

2141. BEGIM L0AD8ASEll,LPL«^ll ; GENSS< »D2,0,3,2,0,1 J ; END 

2142. ELSE eRR0RI99}; 

2143. L0CST2(XC0NS,15); 

2144. EMO 

2145. ELSE BEGIN « MOT IMPLEMENTED « END; 

2146. GENRR<i5,14,l5) ; " FINALLY DO 8ALR " 

2147. GATTR:=TATTR; 

2148. 1:96DPL:=72; RP:=RPSAVE; RRP:=RRPSAVE; TCT!=LTCT; 

2149. END "PASSPARAHS"; 
2150. 

2151. PROCEDURE ASsIGN; 

2152. VAR LATTR-.ATTR; PTR:CTP; 

2153. XSIZE,I:INTEGER; 

2154. AT, COUNT, DS,RS,0D,R0: INTEGER; 

2155. BEGIN 

2156. VARIABLE; L ATTR :=GATTRi 

2157. IF{LATTR.TyPTR3.F0RM>=ARRAYSJ 1 < LATTR. TYPTR= ALFAPTR) THEN 
2153. BEGIN GENSADDRCLATTRI J 

2159, DDj-=SSADDR,D2; R0: = SS AOOR,B2 ; RP:=RP+l; END; 

2160. IF N0-.= 20 « = ".THEN 






• 

• 



• 






2161. BEGIN IF GATTR.TYPTR -.= NIL THEN ERR0R(52); 

2162. SKIP(20); 

2163. IF M0-.=20 THEN 

2164. BEGIN IF GATTR.TYpTR=NI L THEN ERRORI52); GOtO 1 END 

2165. end; 

2166. INSYMBOL; EXPRESSION; 

2167. IF GATTR.TYPTR=NIL THEN SKIP(49) ELSE 

2168. IF LATTR.TYPTR -.= NIL THEN 

2169. BEGINS «« TYPE CHECKING - FIRST PART " 

2170. IF rLATTR.TYPTR=REALPTR) S (GATTR.TyPTR3,F0RM=NJMERIG) THEN 

2171. BEGIN LOAD(GATTR); GATTR. KI ND:=LVAL; GATTR.CTERM:=0; 

2172. FIXEDTOFLOAT; GATTR. TYPTR :=REALPTR; 

2173. END 

2174. ELSE IF LATTR.TYPTR-.=GATTR.TYPTR THEN 

2175. IF {LATTR.TYPTRa.FORM^=NUHERICJ MGATTR,TYPTRa.FORM^=NUMERIC) 

2176. THEN IF{ LATTR.TYPTRa.FORM-,= POI NTER J HGATTR.TYPTR-.=NILPTR ) 

2177. THEN IF f LATTR, TYPTRS.F0R«-.= P0WER1 I ( GATTR.TYPTR-,=LAMPTR) 

2178. THEN ERR0R{53); 
2179. 

2180. " INTEGER AND SYMBOLIC BOUNDS CHECKING « 

2181. TF{LATTR.TYpTRa.FORM=NUMERIG)S<LATTR.TYPTR-.=INTPTR) THEN 
2192. BEGIN 

2183. IF GATTR.KINO=SVAL THEN 

2184. BEGIN IFaATTR.TYPTRa-«IN>GATTR.VALH 

2185. CLATTR.TYPTRa,MAX<GATTR.VALI THEN ERRORCIOIJ; 

2186. END 

2187. ELSE IF ASSCHECK THEN 

2188. BEGIN LOADCGATTRJ; GATTR. KIND:=LVAL ; GATTR.CTeRM:=0; 

2189. CHECKSNDS{STK(RP),LATTR.TYPTRa.MIN, 

2190. LATTR.TYPTR3.MAX,ASSERRi; END 

2191. END 

2192. ELSE IFCLATTR.TYPTRa.FORM=SYMBOLlG)fitLATTR.TYPTR-.= REALPTR} 

2193. £(LATTR.TYPTR-.=ALFAPTR)SCGATTR.KIND'.= SVALi£ASSCHECK 

2194. THEN BEGIN PTR: =LATTR.TYPTRa.FCONST J LQAO(GATTR); 

2195. GAtTR.KIND:=LVAL; GATTR.CTER«:=0; 

2196. CHECKBNDS(STKCRP),0,PTRa. VALUES, iVALUEfASSERRJ; 
21'37. END; 

2198- 

2199. '• CODE IS FINALLY PRODUCED " 

2200. IF(LATTR.TYPTR?9.F0RM>=CLASsS) " CLASS OR FILES " THEN 

2201. ERRaR(53} 

2202. ELSE IF CLATTR .TYPTRa.FORM>POwER) i< LATTR. TYPTR=ALFAPTR» THEN 

2203. BEGIN GENSADDriGaTTRI ; 

2204. DS:=SSAD0R.D2; RS:=SSA0Dr.82 ; 

2205. XSUE:=LATTR.TYPTRS),SIZE; 

2206. IF XSIZE > 256 THEN 

2207. BEGIN COUNT i= iXSIZE -U DiV 256; 

2208. I := I; 

2209. WHILE ( KRP) €1 STKCI ) -»=RSI DO I:*I + l; 

2210. IF STKCI) -»= RS THEN 

2211. BEGIN 

2212. IF RP < ISTKLIM THEN RP:=RP+1 ELSE STKERR; 

2213. GENRRC#18,STK(RP),RS) ; "LR" RS := STK(RP|; 

2214. end; 

2215. I := l; 

2216. WHILE (l<RPUISTK{I*-«=RO) DO I:«I+1; 

2217. If STKCI) -.= RO THEN 

2218. BEGIN ^ i 

2219. I^ ^^P < ^STKLIm THE|^ Rp.^Rp+1 gtSg STKERR? j. 

2220. SE^^RR|#18,STK^RP*,R0); "LR" RO := STK(RP}; | • 
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2221. 
2222. 
2223. 
2224. 
2225. 
2226, 
2227. 
2228. 
2229, 
2230. 
2231. 

^ iC \!$ ^ « 

2233. 
2234. 
2235. 
2236. 
2237. 
2238. 
2239. 
2240. 
2241. 
2242 . 
2243. 
2244. 
2245. 
2246. 
2247. 
2248, 
2249. 
2250. 
2251. 
2252, 
2253. 
2254. 
2255. 
2256. 
2257. 
2258. 
2259, 
2260. 
2261. 
2262. 
2263. 
2264. 
2265. 
2266, 

2267. 
2268 * 

2269. 
2270. 
2271. 
2272. 
2273. 
227 4. 
2275. 
2276 . 
2277. 
2278. 
2279. 
2280. 



ENDt 

XSIZE:=XSIZE MOO 256; 
GENRXC#41,0,C0UNT,0,0) ; " 
AT:=IC; 

GENSS(#D2,D0,255,RD,DS,RS) 
GEMRX(#41, RD, 256,0, RD) ; " 
GEMRX(#41,RS,256,0,RS) ; " 
GENRX(#46,0,0,o,0) ; •♦ 8CT 
INS{AT,IC-2); 
EMO; 

GENSS{#02,DD,XSlZE-l,ROtDSfRS) 
EMO ♦• FORM>POWER OR ALFA " 
ELSE BEGIN LQAD{GATTR); STORE( LATTR} ; 
END; 
i:END "ASSIGN"; 



LA 



LA 
LA 
n 



MVC 



" MVC - FINISH 



END 



GATTR.TYPTR: = NH.; END 



CTPTR:=UNDECPTR; END; 



END 



PROCEDURE VARIA8; 
BEGIN 

IF M0-.= 1 THEN BEGIN ERR0R<49) 
ELSE BEGIN SEARCH; 

IF CTPTR=NIL THEN 8EGIN ERR0R(31) 
IF CTPTRa.KLASS <= PROC THEN 

BEGIN ERRDR(32l; INSYMBOL; GATTR.TYPTR : =N1L; 
ELSE VARIABLE; 
EMO 
END «VARIAB"; 

PROCEDURE ALLC; 

VAR LATTR:AtTR; LC A^RREG ,RREGl, LALIGN:SHRTINT; 

BTI: BOOLEAN; XCDNS:C0NSTANT; PTHCTP; 
BEGIN 

IF si0-. = 9 "(» THEN BEGIN ERR0R(79); SKIP(49); GOTO 10 END; 

INJSYMBOL; VARIA8; PT: = NIL; 

IF GATTR.TYPTR-.=NIL THEN WITH GATTR,TYPTRa DO 

IF FORH-.= POINTER THEN ERR0RC44) 

ELSE BEGIN ADDRESSVARC DOMAIN, LATTR) 
PT:=ELTYPE END; 

IF PT=NIL THEN BEGIN SKIP(49); GOTO 10 END; 

LALIGN:=PT3. ALIGN; 

IF N0=15 THEN ",'• 

BEGIN PTt'PTa.RECVAR; 
REPEAT 

BEGIN Error(66I 






LOADAORILATTR) 



THEN 



SKIP<^9)5 GOTO lO END; 



SKIPC49); GOTO iO END; 



GOTO 10 END; 



IF PT=NIL 
INSY^BCJL; 

IF Nn=l THEN 
BEGIN 

SEARCH; 

IF CTPTR=NIL THEN BEGIN ERR0R(3l) 

IF CTPTS3.KLASS-.=K0NST THEN 
BEGIN eRRGR{63); SKI PC 49); 

PTl:=PTa.CASETYPE; 

IF{ iPTia,FORM=SYMSOLICKCCTPTRa.CONTYPE-.= PTlH i 
{ CPTia.FORM=NUNERIC)S(CTPTRa,CONTYPE-.= INTPTRI) 
THEN BEGIN ERR0RI73); SKIPI49); GOTO 10 END; 

IVAL:=CTPTRi. VALUES. I VALUE 
END 
ELSE IF (N0-.=2H CCL=2) MCL=3) THEN 

BEGIN ERR0R(63); SKIP(49); GOTO 10 END 
ELSE 
BEGIN PTlJ=PTa,CAseTYPE; 



m 



2281. IF {(CL = U£(PT13.F0RM-,=NUMERIC)) I 

2232. ({CL=4U(PT1-.=CHARPTR) J THFN 

2283. BEGIN ERR3R<73); SKIP(49); GOTO 10 END 

2284. END; 

2285. CTPTR:=PT3. VARIANTS; BT1:=FALSE; 

2286. WHILE{CTPTR-.=NIL)S-.BTl DO 

2287. IF CTPTR3.CASeVAL=IVAL THEN BTl:=TRUE ELSE CTPTRr^CTPTRS.NXTEL; 

2288. IF CTPTR = NIL THEN BEGIN I T: = PTS).C ASESI ZE ; PT:=NIL END 

2289. ELSE BEGIN IT:=CTPTRa.CASESIZE ; PT:=CTPTRa. VARIANTS ENO; 

2290. IN SYMBOL*. 

2291. UNTIL N0-.= I5 

2292. END 

2293. ELSE lT:=pTa.s IZE ? 
2294- UPALIGN(IT,LALIGNJ ; 

2295. RREG1:=STK(RPJ; IF RP<ISTkLIM ThEN RP:=RP*-1 ELSE ST^ERR; 

2296. RREG:=STK(RP); 

2297. WiTH XCONS 00 BEGIN KONSTk IND :=INTEGeRS; IVALuE:=IT END; 
2298- GeNRXC#58,RREG,a,0,RREGl); "L - GET FREE POINTER" 

2299. LDCST2iXC0NS,0); 

2300. GeNRR(#lA,0,RReG); "AR - NEW FREE POINTER" 

2301. GENRXl«50,0,0,0,RREGl» ; "ST - SAVE NEW FREE POINTER" 

2302. GE^lRXi#59f0,4f0,RREGl} ; "C - SPACE LEFT IN CLASS?" 

2303. GENRX<f47,12,0,0,0); LCA:=IC-2; "BLE - YES" 

2304. GEMRX{f50,RREG,0,0,RREGl); "RESTORE OLD FREE POINTER" 

2305. GENRR{#lB,RREGtRREG); "SR - NILVAL" 

2306. INSdCfLCAM "FIX UP JUMP" 

2307. STORECGATTRJ; "STORE POINTER TO NEW SPACE" 

2308. IF NQ-.= 10 ")« THEN BEGIN ERR0R(48) ; SKIP(49i END ELSE INSYMBOL; 

2309. 10: END "ALLC"; 
2310. 

2311. PROCEDURE FixEDTOFLOAT; 

2312. BEGIN 

2313. GENRRC#l8fO»STK(RP|)| tiLR» RP:=Rp-l; 

2314. GENRR<#lO,l,0); "LPR" 

2315. GENRS(#88,0,0,3l»0}; "SRL" 

2316. GENRS(i89,0,0,31,0) ; "SLL" 

2317. GEMRSC#90,0,1,72,12) ; "STM INTO TEMPORARY LOCATION" 

2318. GENSI(#96,72,12,#4EJ ; "01 #4E - PSEUOOgXPONENT" 

2319. IF RRP<MAXRSTK THEN RRP:=RRP+l ELSE ERR0R(33J; 

2320. GENRR<#2B,RSTK(RRP),RSTK(RRPn ; "SOR" 

2321. GENRX(#&A,RSTK(RRP),72,0,12); "AD - NORMALIZE" 

2322. END "FIXEDTOFLOAT"; 
2323. 

2324. PROCEDURE FLOATTOF IXEO; 

2325. BEGIN 

2326. RP:=RP+l; 

2327. RRP:=RRP-l; 
232B. END "FL0ATT0FIX6D" ; 
2329. 

2330. PROCEDURE GETpUT; 

2331. VAR VCQN:CQNSTANT; 

2332. BEGIM 

2333. IF NQ-.=9 "<" THEN B^GlN ERR0R(79); SKIP(4^J; GOTO 10 END; 

2334. imsynbol; VARIAB; 

2335. IF GATTR.TYPTR-.= NIL THEN 

2336. WITH GATTR-TYPTRS.VCONfRXAODR DO 

2337. BEGIN 

2338. IF FORM=FILES THEN 

2339. BEGIN "LOAD CORRECT EXTERNAL REFERENCE" 

2340. CASE LPSW OF 










2341. I "EOR'»: BEGIN END; 

2342. 2 "GET": IF FELTyPe=CMARPTR THEN EVALUE: = » PSCLGETC 

2343. Else eVALUE:=«PSCLGETRM 

2344. 3 "PUT": IF FEtTyPE=CHARPTR THEN EvALUE :=• PSCLPUTC 

2345. ELSE E^ALUej^ . PsCLPUT^* ; 

2346. 4 "RESET": BEGIN END; 

2347. EmO "CASE"; 

2348. GENAOOR(GATTR,0) ; "ADDRESS OF FCB" 

2349. GENRX(#41,l,D2,X2tB2) ; "LA I NTO Rl " 

2350. K0NSTKIND:=EXTREF; | 

2351. L0CST2(VCQN,15); , ^ 

2352. GENRR(#5,14,15»; "8ALR TO I/O ROUTINE" ; • 

2353. END 

2354. ELSE IF { FORM=POINTER) &( LPSW=4) THEN ^ 

2355. BEGIN LOAOCGATTR); "VALUE TO RESET" • 

2356. AODRESSVARCOOHAIN.GATTR); 

2357. STOREIGATTR); ^ 

2358. END ^ 

2359. ELSE ERR0^U4}-, 

2360. E^O; , ^ 

2361. IF MO^=lO ")" Then begin ERR0RC48I; SKlP<49) EnO ElsE INSYMBOL; j • 

2362. lO:£^iD ««GEtpUT"; , 

2363. ; ^ 

2364. PROCEDURE INSAPP; 1 ~ 

2365. VAR LATTR:ATTR; i 

2366. BEGIN I ^ 

2367. IF N0-.=9 "<" THEN BEGIN ERR0RI79); SKIPC49J; GOTO 10 END; : • 

2368. INSYMBOL; | 

2369. IF LPSy=8 THEN EXPRESSION ELSE VARIAB; i ^ 

2370. IF GATTR,TyPTR-.= NIL THEN ' I ^ 

2371. IF GATTR,TYPTRa.FORM-.=NUMERlC THEN ERftOR(44J ELSE LOADCGATTRI; ! 

2372. LATTR:=GATTR; , ^ 

2373. IF M0-.= 15 THEN BEGIN ERR0RI80) ; SKIP<49); GOTO 10 END; I • 

2374. IMSYM80L; EXPRESSION; ! 

2375. WITH GATTR DO I ^ 

2376. IF TyPtR^=NIL THEN i • 

2377. IF TYPTRa«Er)RN-.= NUHERlC THEN ERR0RC44-) 1 

2378. ELSE IF KIND=SVAL THEN GENRSC j|89tSTKCRP} t VAt,0,0 J "SLL" 

2379. Else BEGIm LOADCGATTr); rP:=rp-i; • 
23S0. GENRSt#a9,STK{RPi,0,Q,STK(RP*l)} ««SLL« 

2381. E^D; I ^ 

2382. IF N40-. = 15 THEN BEGIN £RR0R<80J; SKIPC49); GOTO 10 END; • 

2383. IMSYMSOL; 

2384. IF LPSW=8 THEN VARIAB ELSE EXPRESSION; ^ 

2385. WITH GATTR 00 i • 

2386. IF TYPTR-.=NIL THEN 

2387. IF TYPTRa.FORM-,= NUMERIC THEN ERR0R<44) ^ 

2388. ELSE BEGIN LOAD(GATTR); RP:=RP-1; • 
?3B9. GeNRR(|il6,STKIRPltSTK(RP4-l) J; 

2390. IF LPSW=8 THEN STORECGATTRJ ELSE STORElLATTP^i ^ 

2391. END; j • 

2392. IF M0-.= l0 M)« Then begin ERR0RU8); S'<lP<49l eno else insymbol; 

2393. 10:e^D ««INSAPP"; ^ 

2394. • 

2395. PROCEDURE PCK; 

2396. VAR LPTtCTp; SREG»0»L: ShrTjnT • 

2397. BEGIN • 

2398. IF M0-.=9 "«" THEN BEGIN ERRORIyg); SKlP{49J; GpTO LO END; j 

2399. insymBol; varIab; I ^ 

2400. HflTH GATTR DO i • 



• 



2401. 
2402. 
2403. 
2404. 
2405. 
2406. 
2407. 
2408. 
2409. 
2410. 
2411. 
2412. 
2413. 
2414. 
2415. 
2416. 
2417. 
2418. 
2419. 
2420. 
2421. 
2422. 
2423. 
2424. 
2425. 
2426. 
2427. 

242 8. 
2429. 
2430. 
2431. 
2432. 
2433. 
2434. 

243 5. 
2436. 
2437, 
2438. 
2439. 
2440. 
2441. 
2442. 

2443. 
2444. 
2445. 
2446. 
2447. 
2448. 
2449. 
2450. 
2451. 
2452. 
2453. 
2454. 
2455, 
2456. 
2457. 
2458. 
2459. 
2460. 



IF TYPTR-.=NIL THEN 
WITH TYPTR3 DO 
BEGIN 

if form-.= arrays then err0ri44) 

else if aeltype-.=charptr then err0r(44) 

Else begin lpt:=inxtype; dplmt:«oplmt-lo end; 

L := SIZE; LnAOAOR(GATTRl 
E-^D 

ELSE BEGIN LPT-=INtPTR; L:=i; "ERRoR CqnOX" ^NO; 
IF L>10 THEN L:=10; 

If no-.=15 Then begin eRRORtso); sKipu9); gOjO lo end* 
insymbol; expression; 

WITH GATTR do 

if TYPTR-.=NIL THEN 

IF (TYPTR3.F0RM-.= NUM6RIGJ |(LPTa.FORM-.= NU«ERICI THEN 
BEGIN IF TYPTR-.=LPT THEN ERR0R(44) END 

ELSE IF KIND=SVAt THEN 0:=VAL 
ELSE 
BEGIN 

LOADJGATTR); RP:=RP-1; 0:=0; 

GENRRC#lAf STKCRP),STKCRP*-l)l ; "AR" 
END; 

SREG:=RP; 
IF NO-i^lS THEN BEGIN ERR0RC80}; SKIPC49>; GOTO 10 END; 

I'^symSol; varIab; 
with gattr, ssaoor do 
IF typtr-,=nil then 

IF TYPTR-^=ALFAPTR then ERR0RC44) 
ELSE 

BEGIN gensaddr(gattr); 

GENSS(#D2,D2,L-ltB2,0,STK«SREG}} ; "MVC" 
END; 
IF N0-.-10 ")" THEN BEGIN ERR0RC48n SKIP149) END ELSE INSYMBOL; 
10: END «PCK«; 

PROCEDURE REAOIR; 

BEGIN 

END "READIR'M 

PROCEDURE TITLE; 

BEGIN 

END "TITLE"; 

PROCEDURE UNPCK; 

VAR LPT:CTP; DtLDt LB : ShrTinT; 

BEGIN 

IF M0-.=9 »»(« tHEn bEGIn ERR0R{79)» SKIPI49}; GO^O 10 END; 

INSYH80L; EXPRESSION; 
WITH GATTR, SSADDr DO 

IF typtr-i^nil then 

IF TYPTR-.= ALFAPTR then ERR0R144) 

ELSE BEGIN GENSAODRI GATTRI ; LD:=D2; La:=82; RP:=RP+1 END; 
IF N0-.= 15 THEN BEGIN ERROROO); SKIPC49); GOTO 10 END; 
INSYMBOL; VARIA8; 
WITH GATTR DO 
IF TYPTR-.=NIL THEN 
WITH TYPTRa DO 
BEGIN 

IF FORM-.=ArrAyS THEN ERRQRC44) 

Else if aeltypE-^^cHarptr then error{44) 






• 






• 
• 



2461. ELSE BEGIN LPT:=INXTYPE ; 

2462. DPLMT:=DPLMT-LO 

2463. END; 

2464. L0ADADR(G4TTR) 

2465. EiMO 

2466. ELSE LPT:=INTPTR; 

2467. IF NJ0-.= 15 THEN BEGIN ERP0R{80); SKIPi49)i GOTO 10 END; 

2468. I^SYMBOL; EXPRESSION; 

2469. WITH GATTR DO 

2470. IF TYPTR-.=NIL THEN 

2471. IF (TVPTRi.FORM^=NUMERIC)l (LPTS)-FORM-.= NUMERIG) THEN 

2472. BEGIN IF TYPTR-»=LPT THEN ERROR (44) END 

2473. Else if kind=sval then D:=VAL 

2474. ELSE BEGI^ LOADIGAtTR); RP:=RP-l; D:=0; 

2475. GENRRC#IA,STK(RP),STK<RP+1H "AR" 

2476. END; 

2477. GENSSC#D2,0,9,STK(RP)ftO»LBI; "MVC" 

2478. if Ma-.= 10 ")" THEN BEGIN ERR0RC48I; SKrP(49) END ELSE INSYMBOL; 

2479. 10: END "UNPCK"; 
2480. 

2481. PROCEDURE WRITE IR; 

2482. BEGIN 

2483. END "WRITEIR"? 
2484. 

2485. PROCEOURE WRITOUT; 

2486. VAR I,ES0ID,J,LIC»AHT:SHRTINT; 

2487. K: INTEGER; 

2488. BEGIN 

2489. PASCALGOa:=BLANKCARO; 

2490. "FIRST ESD ITEM iS CSecT NAME" 

2491. PASCALG0a(lI: = CHR(2}; UNPACK( « ESD « ,PASC ALG03,2H 

2492. PASCALG03(ll)j=CHR(0); pAsCALGoai 12) :=CHR( 16) ; 

2493. UNPACK {BLANKALFA,PASCALG03, 131 ; 

2494. PASCALG03{15}:=CHRtO) ; PASCALGOaC 161 :=CHrC I) ; 

2495. UNPACKCCNAHE,PASCALG03f 17) ; 

2496. FOR l:=25 TO 28 00 PASCALG03( I) :=GHRC 0) ; 

2497. PASCALG0aC29>: = « •; PASCALGOaOO) :=CHR( IC DIV 65536); 

2498. PASCALG03(31):=CHRCIC MOO 65536 DI V 256) ; 

2499. PASCALG03(32):=CHR(IC MOO 256); 

2500. PUT{PASCALGO); 

2501. "WRITE OUT ESD ENTRfES FOR EXTERNAL REFERENCES" 

2502. £SD!D:=l; I:=eLCX; UNPACKC BLANKALFA, PASCAL GOa, 29 ) ; 

2503. WHILE I-.= 00 

2504. BEGIN 

2505. ESDID;=ESOID+l; PASCALGOSC 15) :=CHR< ESOID DIV 256); 

2506. PASCALG0a(l6):=CHR<eSOID MOO 256); 

2507. UNPAC<<CSTT6(I).VALU.EVALUEfPASCALG0atl7) ; 

2508. PASCALG0a(25):=CHRC2); 

2509. FOR Ji=26 TO 28 DO pAsCalGqsI J) :«CHRiO) ; 

2510. PUTCPASCAlGo*; 

2511. I: = CSTTB{I).CNE>«T; 

2512. EnD; 

2513. "WRITE OUT eSd ENTrjeS FOR EXTERNAL LABEL REFERENCES" 

2514. PASCALG03(15):=» *> PASCALGOSC 16) :=' •; 

2515. PASCAL GOaC 29): = ' •; PASCALGOiOO) i=CHR<0) ; 

2516. PASCALG0i(31):=CHR(0); PASCALGOaC 32 ) :=CHRC 1) ; 

2517. FOR IT:=FSTIXG TO CEXTABIX DO 

2518. BEGIN 

2519. FOR IT1:=1 TO CLA8IX DO 

2520. IF EXTA8(ITI.EXVAL=LA8TAB(ITl),LA8VAL THEN 



m 
m 
m 



m 
m 
m 



2521. BEGIN 

2522. UNPACKiEXTAB( I T) .EXTNAME * PASCALGOa, 17) ; 

2523. PASCALG03(25):=CHR(1) ; K:=LABTAB( ITl) .LABLOC; 

2524. PASCALG05)(26):=CHR(K OIV 65536); 

2525. PASCALG0a(27):=CHR(K MOO 65536 DIV 256); 

2526. PASCALGD3(28):^CHR(K MOO 256); 

2527. PUKPASCALGO) ; 

2528. GOTO 1 

2529. end; 

2530. ERRMESSAGEi 'EXIT: • ,EXTAB( IT) .EXVAL) ; 

2531. UEMD; 

2532. "WRITE OUT TEXT CARDS" 

2533. UNPACK(»TXT»,PASCALG03»2); PASCALG03( I I ) :=CHR(0 ) ; 

2534. PASCALG03( 13)-: = * *i PASCALG03{ 14) : = • •; 

2535. PASCALG3S( 15):=CHR(0); PASCALGOat 16) :=CHRCl) ; 

2536. LIC:=0; 

2537. WHILE LIC<IC DO 

2538. BEGIN 

2539. IF IG-LIG>=56 THEN AMT:=56 ELSE AMT:=|G-LIG; 
2540- PASCALG0S(6):=CHRItIC DIV 65536); 

2541. PASCALG0aC7):=CHR(LlC MOO 65536 DIV 256); 

2542. PASCALG0a(8):=CHR(LlC MOD 256); 

2543. PASCALG0a{ 121 :=CHR{ AMT) ; 

2544. FOR I: = LIC TO AMT+LIC-1 DO PASCALGOaC I-LIG+17) :=CHR( CODEC I) ) ; 

2545. FOR I: = AMT-H7 TO 72 00 PASCALGOail ) t = » •; 

2546. Lie:=Lie+AMT; 

2547. PUTCPASCALGO) 

2548. END; 

2549. "WRITE OUT RLD CARDS" 

2550. PASCALGOa:=BLANKCARD; PASCALG03U ) :=CHRC2) ; 

2551. UNPACK (*RLO»,PASCALGOa, 23; 

2552. PASCALGQi{ll):=CHR(OJ; PASCALG0aU2) i=CHR( 81 ; 

2553. PASCALG0a{l9):=CHR(0); PASCALGOa{ 20) :=CHRC 1 ) ; 

2554. PASCAL GOai 211 :-CHR{ 28) ; 

2555. ESDIO:=l; I:=ELCX; 

2556. WHILE I-^^O 00 

2557. BEGIN ESDIOt =£SOID-H; 

2558. PASCALG0acl7):=CHR(ESoiD DiV 256) I 

2559. f*AsCALGoaM8):=CHR{ESOlD MOD 256); 

2560. Kj=CsTTBCII.InX; PASCALGOai 22) :=chR (K OIV 65536); 

2561. PAsCALG0at23):=CHRCK MOD 65536 DIV 256); 

2562. PASCALG0ai24):=CHR{K MOD 256); 

2563. PutCpAsCA|_Gq); 

2564. I:=CSTT8(n,CNEXT 

2565. END; 

2566. "WRITE OUT END CARD" 

2567. PASCALG0a:=8LANKCAR0; PASCALGOSl 1 I :=CHRC2) ; 

2568. IJNPACKC»ENDSPASCALG0S,2); 

2569. PyT(PASCALGO); 

2570. IF(LEVEL=0)S{CNAME='$$$HAIN*l THEN 

2571. BEGIN 

2572. UNPACKC INCLUDE S» tPASCALGOa,! I ? 

2573. UNPACK( 'YSLlBCPSCL'fPASCALGOa.llJ; 

2574. UNPACK(»MaN) • , PAsCALGOa ,21) ; 

2575. PUTCpASCALGO); PASCALGOa:*BLANKCAR0t 

2576. UNPACKC • ENTRY PSC • ♦ PASCALGOa*! I ; 

2577. UNPACKC'LMON • , PASCALGOa,ll ) ; 

2578. PUT(PASCALGO); 

2579. E^O 

2580. END "WRITOUT"; 
2581. 
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258Z. 
2583. 
2584. 
2585. 
2586. 
2587. 
2588. 
2589. 
2590. 
2591. 
2592. 

2593. 
2594. 
2595. 
2596. 
2597. 
2598. 
2599. 
2600. 
2601. 
2602. 
2603. 
2604. 
2605. 
2606. 
2607. 
2608. 
2609. 
2610. 
2611, 
2612. 
2613. 
2614. 
2615. 
2616. 
2617. 
2618, 
2619. 
2620. 
2621 . 
2622. 
2623. 
2624. 
2625. 
2626. 
2627. 
2628, 
2629. 
2630. 
2631. 
2632. 
2633. 
2534. 
2635, 
2636. 
2637. 
2638. 
2639. 
?640« 
2641, 



SKIPt24) 



GATTf^.TYPTR = nI t THen ERR0R«56| ; 
ERRCL(NO) = ENOSY THEN GOTo 30 ; GOTO 20 



20: 
30: 



PROCEDURE IFSTAT ; 

VAR LCAl, LCA2: ADORESS; 

3EGIM 

INSYM80L ; EXPRESSION ; 

IF GATTR.TY'TR -.= NiL THEN GENJPIO) ; 

LCAI := lG-2; 

If M3 -.= 24 THEN " SY -,= THEN " 

begin 

IF GATT'^.TYPtR -.= NIl THEN ERR0R(56) 
IF mO -,= 24 THEm 

BEGn 

IF 
IF 

END 
EMO ; 

INSYMBOL ; 
STATEMENT ; 

ISTKLI^:=MAXI$TK; ASTKtMAXISTKJ:=0; 
IF M3 -.= 25 THEN " SY -.= ELSE " 
INSUCLCAU ELSE 
BEGIN 

GeNRX{#47f#F, 0,0,0) ; 

LCA2 := IC-2; 

IMS(IG,lCAU; 

INSY^^BOL ; STATEMENT ; 

INSCIG,lCA2J; 

ISTKLIM: = MAxISTK; ASTKC MAXI STK^ :=0 

Eno 
end " ifstat " ; 



m 



I # 

! 



PROCEDURE CASESTAT ; 
TYPE PTR = 3LCSLABS ; 
VAR LCSLABS : CLASS 30 



OF "PACKED" 



CSJWP, 3ASEJMP, OUTCASE, LMIN, 
LPTR, PTl, PT3 : PTR ; LCTP 



RECORD NEXT : PTR ; 

CSLAB : SHRTINT ; 
AOOR : ADDRESS ; 
END ; 
LMAX : SHRTINT ; 
CTP ; 



BOOLEAN ; PTI,PT2 : PtR 
OF" IN SYMBOL ; 



BJ: CONSTANT; LERR: BOOLEAN; 

PROCEDURE ACASE ; 

VAR lT»FIXUP : ShRTINT ; LERRFG : 

BEGI^ lErrFG := TrUe ; 

REPEAT If tN0=15} HN0=27) ThEN "♦ 
lTr=4097; "GREA'TeR THAN TH0t012" 
IF NO = 1 THEN "19" 
BEGIN SEARCH ; 

IF CTPTR = NIL THEN 

BEGIN ERR3R(3l) ; CTPTR := UNOECPTR 
WITH CTPTRa DO 

BEGIN IF KLASS -= KONST THEN 
BEGIN IF LERRFG THEN ERR0RC61I 
IF CONTYPE -.= NIL THEN 
BEGIN IF CONKIND = FORMAL THEN 
BEGIN ERROR (61) J GOTO 1 END ; 
IF LCTP = NIL THEN LCTP := CONTYPE ELSE 
IF LCTP -.= CONTYPE THEN ERROR! 73) J 
IT := VALUES. IVALUE ; 
EmO 



END 



GOTO I END 
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2642. 
2643- 
2644. 
2645. 
2646. 
2647, 
2648. 
2649. 
2650. 
2651. 
2652. 
2653. 
2654. 

2655. 
2656. 
2657. 
2658. 
2659. 
2660. 
2661. 
2662. 
2663. 
2664. 
2665. 
2666. 
2667. 
2668. 
2669. 
2670, 
2671. 
2672, 
2673, 
2674, 
2675, 
2676. 
2677. 
2678. 
2679, 
2680. 
2681, 
2682, 
2683, 
2684, 
2685. 
2686. 
2687. 
2688. 
2689, 
2690. 
2691, 
2592, 
2693, 
2694, 
2695, 
2696. 
2697, 
2698, 
2699, 
2700, 
2701, 



END 
END "IF NO = I" ELSE 
IF NO = 2 THEN '•CONST" 
BEGIN CASE CL OF 

PT := INTPTR 
REALPTR ; 
ALFAPTR ; 



l: 
2: 
3: 

4: 



BEGIN 
PT : = 
PT : = 

BEGIN 



IT:=IVAL END 



PT := CHARPTR ; IT:=INT(CHVAL> END 



END ; 

IF LCTP = NIL 

IF LCTP ^= PT 

END "IF NO = 2" 

BEGIN 

IF IT 



• 



THEN LCTP := PT ELSE 
THEN ERRQR(73) ; 
. .._ _ ELSE 

IF LE«^FG Then ERR0R(61) ; GOjO I 
>= TW0TO12 tHeN ERROR! lOO) ; 



END 



PTl := LPTR ; PT2 :- NIL 



LERRFG := FALSE 
IF -^ERR THEN 
WHILE PTl ^= NIL 00 
BEGIN IF PTIS.CSLAB >= IT THEN 
BEGIN IF PTia,CSLAB = iT ThEN 
;= PTl ; PTl := PTl a. NEXT 



# 
• 



ERR0R177) ', GOTO 3 END 



"IT>ALL PTia.CSLAB»S» 
"NEW LABEL-DESCRIPTOR" 

THEN 



PT2 

END ; 

LMAX := IT ; 
3: ALL0C{PT3) ; 

IF PT3 -= NIL 
BEGIN WITH PT3a DO 

BEGIN NEXT := PTl 

IF PT2 = NIL THEN 

BEGIN LPTR := PT3 
END ELSE ERR0R(7il 
INSYMBOL ; 
M^JIL NO -.= 15 ; 
IF nO -»= 19 THEN «:" 
l: STATEMENT ; GENRXt #47» 15* 0*0,01 

IF NO = i6 Then «;" 

sEglnj Imsymbol ; if no -.= 22 Then acase end else 

if errcl(n3} = begsy then 

begin err0ri58i ; goto i end 

if no -= 22 then error (68) ; 

basejmp:=ic-lmin*2; 

0utcase:=basejhp+{lmax+1}*2; 

INS(OUTCASEfFIXUP) 
END "ACASE" ; 



"»" 



CSLAB :- IT ? AODR i~ IC END ; 

LMIN := IT END ELSE PT2S,NEXT := PT3 



ERR0RJ64I ELSE INSYMBOL ; 

"B«« FlXUP:=lC-2; 



ELSE 



• 



BEGIN " 
LMIN 

INSYM 

LCTP 

IF LC 

BEGIN 

IF 

BEG 

LOA 

END ; 

"IF IN 

BEGIM 

LCA 

GEN 

GE^I 

GEN 

END ', 



CASESTAT" 

:= ; LMAX := ; LPTR := NIL ; LERR := ERR ; ERR := FALSE ; 

BOL ; EXPRESSION ; 

t= GATTR.TYPTR ; 

TP -= NIL THEN 

IF LCTP3,F0RM = NUMERIC THEN LCTP := INTPTR ELSE 
(LCTPa.FGRM > SYMBOLIC M{ LCTP = REALPTR) | (LCTp = ALFAPTRI THEN 
In Error C 62) ; LCTP := NIL END I 
OcGaTTR); 



• 



xcheck then 

G£\j 30(718, 7,0, Id *, 
1 := CA ; LCPl := CP 
30(718,2,0,0) ; LCA2 := CA ; LCP2 := CP 
15(378,2,2,11 ; GEN15CI2B,2,2,0) ; 
30(036, 3, 2tINXERR) 



GEN30C71Bf2»0«0) ; 
; GEN15(37B,0,1,2) 



2T02. 
2703. 
2704. 
2705. 
2706. 
2707. 
2708. 
2709. 
2710. 
2711. 
2712. 
2713. 
2714. 
2715. 
2716. 
2717. 
2718. 
2719. 
2720. 
2721. 
2722. 
2723, 
2724. 
2725. 
2726. 
2727, 
2728. 
2729. 
2730. 
2731. 
2732. 
2733. 
2734. 
2735. 
2736. 
2737. 
2738. 
2739. 
2740. 
2741. 
2742. 
2743 . 
2744. 
2745. 
2746. 
2747. 
2748. 
2749. 
2750. 
2751. 
2752. 
2753. 
2754. 
2755. 
2756. 
2757. 
2758. 
2759- 
2760. 
2761. 



IF NO -.= 27 THEN "OF" 

BEGIM IF LCTP -.= NIL THEN ERR0R(65) ; SKlP{27) ; 

If Nil -.= 27 THEN 

IF LCTP = NIL THEN ERR0R(65) ; 
E^JD ; 

GENRR(«U,STK<RP),STKIRP)I; "AR" 
GENRX{#4A»STK{RP)»0f0t0); "AH" 

csjmp:=ic-2; 
genrx<#48,1,0,stk(rp),basereg(1) ) ; "lh" 

GENRX(#47,15,0,1,3ASEREG(U I; "B" 

ACASE ; 

WITH BJ DO BEGIN KQNSTKI NO : = INTEGERS; I VALUE:=BASEJMP. END; 

GeNlC3MST{BJ,CSJMP); 

"IF INXCHECK THEN 



INSaMAX,LCP2,LCA2) 



END ;■ 



BEGI»^ INS(LHntLCPlfLCAll ; 

IT := LMIN ; PT1:=LPTR; 

IF -ERR THEN 

WHILE PTl -= NIL DO 

BEGIN 

WHILE {IT<PT 13. C SLAB >D0 
BEGIN 

CODE! IG):=aUTCASE OIV 256; 
CODEC IC+1):=0UTCASe MOD 256; 
lC:=IC+2; 
IT:=IT+1 
END; 
CnOE(IC):=PTia.AODR OIV 256; 
CODEC IC*-l):=PTia,ADDR MOD 256; 
IC:=IC+2; 
IT:=IT+l; 
PT1:=PT1S.NEXT 
END; 

IF NO = 22 THEN "END" INSYM80L ; 
ERR:=ERRlLeRR 
END "CASESTAT" ; 

PROCEDURE REPEATSTAT ; 
VAR LJPADDR: ADDRESS ; 
BEGIM 

LJPADDR := IG ; 

ISTKLIH:=MAXrSTK; ASTkI MAXlSlK) :=0; 

REPEAT 

BEGIM 

INSVNBOL ; 
20: STATEMENT ; 

IF ERRCHNO) = BEGSY THEN BEGIN ERROR(58) ; GOTO 20 END ; 
IF NO = 25 THEN "ELSE" 

BEGIN ERR0RC54) ; INSYHBOL ; GOTO 20 END 
END 

UNTIL NO -' 16 ; " SY -= ; " 

IF NO -= 29 THEN " SY -.= UNTIL " ERR0RI67} ELSE 
BEGIN 

INSY^^BOL ; EXPRESSION ; 

IF GATTr.TYpTr -,= NIL TheN GENJPIL JPAOOR) EtsE SKlP'C49J 

End 
end " repeatstat " ; 

PROCEDURE WHILESTAT ; 

VAR LJPADDR : ADDRESS; LCA : ShRTinT; 

BEGIN 
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• 






• 



2762. 
2763, 
2764. 
2765. 
2766. 
2767. 
2768. 
2769. 
2770. 
2771. 
2772. 

2773. 
2774. 
2775. 
2776. 
2777. 
2778. 
2779. 
2780. 
2781. 
2782. 
2783. 
2784. 
2785. 
2786. 
2787. 
2788. 
2789. 
2790. 
2791. 
2792. 
2793. 
2794. 
2795. 
2796. 
2797. 
2798. 
2799. 
2800. 
2801, 
2802. 

2803. 
2804. 
2805. 
2806. 
2807. 
2808. 
2809. 
2810. 
2811. 
2812. 
2813. 
2814. 
2815. 
2816. 
2817. 
2818. 
2819. 
2820. 
2821. 



20: 
10: 



ISTKLIM:=MAXISTK; ASTK(MAXISTK):=0; 

LJPAODR := IC ; 

IMSYMBOL ; EXPRESSION ; 

IF GATTR.TYPTR ^= NIL THEN GENJP(O) ; 

LCA := IC-2; 

If MD -1= 31 THEN " SY -,= DO " 

bEGIn 

IF GATTR.TYPtR -= NIL THEN ERR0R(59) ; SKIPI31) 

IF NO -.= 31 THEN 

BEGIN 

IF GATjr.TYPTR = NIL THEN ERRof^^Sg) J 
IF ERRCLINO) = BEGSY THEN GOTO 20 ; GOTO 10 
END 
END ; 

INSY^^BOL ; 
STATEMENT ; 

GENRX(#47fl5,0f0,0l ; I NSILJPADDRf IC-2 ) ; 
INSCICLCA); 

ISTKLIM:=MAXISTK; ASTK(MAXI STK» :=0 
END « WHILESTAT « ; 



• 



• 
• 



PROCEDURE FORSTAT ; 

VAR LATTR,TATTR : ATTR ; LCLASS, LCA, I 

LJPAODR : ADDRESS ; LOF : BOOLEAN ; 

XTCT:ADDRESS; PTR:CTP; 



SHRTINT 



PROCEDURE CHTyPE ; 
bEGIni 

WITH GAttR 00 

IF TYPTR -.= NIL THEN 

If CTYPTRa.FORM > SYMBOLIC) 1 C TYPTR = ftEALPTR|| 

(TYPTR = ALFAPTRJ THEN 

BEGIN ERR0R{62) ; TYPTR := NIL END 
END ; 

PROCEDURE CHTYPES ; 
BEGIN 

WITH GATTR 00 

IF (TYPTR -= NIL)e(LATTR. TYPTR ^= NIL) THEN 

IF({TYPTR3,F0RH = SYMBOLIC H CLATTR.TYPTR3.F0RM = SyMBnLlGn& 

(TYPTR -= LATTR. TYPTR) THEN 

BEGIN ER^0R(73) ; TYPTR := NIL END 
ENf^ ; 

BEGIN ISTKLlH J= MAXISTK; ASTkC MAXI STK) := I 

LCA := ; 
insymbol ; 
if no -1= 1 then 

BEGIN ERR0R(49) ; GATTR.TyPTR l= NIL END ELSE 
BEGIN SEARCH ; 

IF CTPTR = NIL THEN 

BEGIN ERROROl) ; CTPTR :=. UNDECPTR END ; 

IF CTPTRa.KLASS <= PROC THEN 

BEGIN ER!?0R(32) ; INSYMBOL END ELSE VARIABLE 
END J 
CHTYPE ; 

IF GATTR.TYPTR ^= NIL THEN 
WITH GATTR DO 
IF ACCESS -= DRCT THEN 
BEGIN ERR0R(69} ; TYrTr := NIL END ELSE 



• 

• 

• 

• 



IF GATTR.TYPTR -.= 


NIL THEN ERRnR(52) ; 


SKIP(20); 


IF NO 


-.= 20 THEN 












BEGIM 














IF 


GATTR-TYPTR 


= NIL 


THEN 


ERR0R{52} 


• 
f 




IF 


ERRCLINO) = 


BEGSY 


THEN 


GOTO 20 ; 


GOTO 


10 


END 














EMO ; 














INSVM80L 


; EXPRESSION 


; 










CHTYPE ; 


CHTYPES ; 













2822. IF (8REG-^=0)fi(BREG^=LEVEL) THEN ERRnRI69> 

2823. LATTR := GATTR ; 

2824. IF NO -= 20 THEN '• SY -.= := •• 

2825. BEGIN 
28 26 . 
2827. 
2828. 
2829. 
2830. 
2831. 
2832. 
2833. 
2834. 

2835. LOAO{ GATTR); 

2836. IF *J0 -»= 33 THEN " SY ^= TO/DOWNTO •• 

2837. BEGIN 

2838. IF GATTR.TYPTR -.= NIL THEN ERR0R{70l ; SKIP(33) ; 

2839. IF MO -.= 33 THEN 

2840. BEGIN 

2841. IF GATTR.TYPTR = NIL THEN ERR0R{70) ; 
2842- IF ERRCL(NO) = 8EGSY THEN GOTO 20 ; GOTO 10 

2843. END 

2844. END ; 

2845. LCLASS J= CL ; 

2846. INJSYMBOL ; EXPRESSION ; 

2847. CHTYPE ? CHTYPES ; 

2848. XTCT:=TCT; 

2849. IF (GATTR.TYPTR -.= NIL) S{ LATTR-TYPTR -.= NIL) THEN 

2850. BEGIN 

2851. IF GATTR*KIND=SVAL THEN 

2852. BEGIN TATTR :=GATTR ; LJPA00R:=1G; LOAD<TaTtR) ; RP:=RP-1 END 

2853. Else with tattr do 

2854. BEGIN 

2855. LOADCGATTRI; UPALIGNC TCT»4I I 

2856. ALIGNMENT :=4; KINDi=VARBL; TyPTR :=INTPTR; 

2857. BREGJ^LEVEL; DPLMT:=TCT; ACCESSs'ORCT ; 

2858. PCKD:=FALSE; STORE CTATTR) ; TCT:=TCT+4; 

2859. IF TCT>TNAX THEN TMAX:=TCT; LOF:=FALS£; 

2860. LJPA0DR:=IC 

2861. END; 

2362- IF LCLASS = I THEN "STEP +1" GENRRC #19,STK( RP) ,STKIRP+1 I ) 

2863. ELSE "STEP -I" GENRRC #19,STK(RP+l) ,STK(RP) ) ; 

2864. GENRX(#47,f2,f0,#O,#0) ; LCAJ= IC-2; 

2865. IF ASSCHECK THEN 

2866. WITH LATTR. TYPTR3 DO 

2867. IF FORH = NUMERIC THEN 

2868. BEGIN IF LATTR. TYPTR -= INTPTR THEN 

2869. CHECKBNDSISTKCRP),MIN,MAX,0) 

2870. END ELSE CHECKBNDS* STK<RP» ,0,FC0NST3. VALUES. I VALUE, 0) ; 

2871. STORE (LATTR I; 

2872. END ; 

2873. IF NO -.= 31 THEN " SY -»= 00 " 

2874. BEGIN 

2875. IF GATTR.TYPTR -.= NIL THEN ERR0R(59l ; SK|P{31) ; 

2876. IF NO ^= 31 THEN 

2877. BEGIN 

2878. IF GATTR.TYPTR = NIL THEN ERR0R(59) ; 

2879. IF ERRCL(N0J = BEGSY THEN GOTO 20 ; GOTO 10 

2880. END 

2881. END ; 
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28B2. 
2883. 
283'+. 
2885. 
2886. 
2887. 
2888. 
2889. 
2890. 
2891. 
2892. 
2893. 
289^. 
2895. 
2896, 
2897. 
2898. 
2899. 
2900. 
2901. 
290 2. 
2903. 
2904. 
2905. 
2906. 
2907, 
2908. 
2909. 
2910. 
2911. 
2912. 
2913, 
2914. 
2915. 
2916. 
2917. 
2918. 
2919. 
2920. 
2921- 
2922. 
2923. 
2924. 
2925. 
2926, 
2927. 
2928. 
2929. 
2930. 
2931. 
2932. 
2933. 
2934. 
2935. 
2936. 
2937. 
2938. 
2939, 
2940* 
2941. 



20: 



105 



1: 



insymbol ; 
statement ; 

if lattr.typtr -= nil then 
begi^j loadclattri; 
If lclass=i then 
begin genrx{#41,0,1,0»0) ; "la" 

GEMRRi[#lAfSTK(RP) tOI "AR" 
END 
ELSE GEMRR( #6»STK<RP),0) ; "BCTR" 
IF TATTR.KIND-.= SVAL THEN 

BEGIN LQA0{TATTR); RP:=RP~2 END 
ELSE RP:=RP-1; 
GeNlRX(#47,15,0,0,0H "B" 
IMS(LJPA00R,IC-2); INSCIGtLCA) 
END ; 

TCT:=XTCTi 

ISTKLIM:=«AXISTK; ASTK(MAXISTK) :=0; 
E!^0 " FORSTAT » ; 

PROCEDURE GOToSTaT ; 
VAR XCONS: CONSTANT; 

bEGIn Insymbol ; 

IF (NO = l)6(AVAL = »EXlT«i THEN 
BEGIN INSYMBOL ; 

IF (NO -.= 2} HCL ^= II THEN 
BEGIN ERRORtSl) ; SKIPi49) END ELSE 
BEGIN FOR IT := CEXTA8IX DOMNTO 1 00 
IF EXTAB( ITJ.EXVAL = IVAL THEN 
BEGIM ITl i- EXTABCITl.EXLEVEL ; 

IF ITI=0 THEN GENRR{#18,i3,12l «LR'« 
ELSE IF ITl-.=LeVEL THEN L0AD8ASE ( 13,1 Tl ) 
ELSE ERR0R(61) ; 
WITH XCONS 00 

BEGIN KONSTKINOl=EXTREF; 

EVALUE:=EXTABnT).EXTNAME 
END; 
LDCST2(XC0NS»STKC1)); "GET V-CON" 
GEf*jRS(#g8,14,4»12,i3) ; mlM" 

GENRRJ»T,15,STkj1H ; "BRANCH" 
GOTO I 
END ; 

ERROR! 43) ; 
INSYMBOL 
END 
END ELSE 

IF (Na -.= 2) HCL ->= II THEN 
BEGIN ERR0R(61I ; SKIP{49I END ELSE 
BEGIN IF IVAL >= TW0T012 THEN ERRORflOOl ; 

" SEARCH THROUGH LABELTABLE OF CURRENT BLOCK " 
GENRX(f47,15,0,0,0) ; "BRANCH" 
FOR IT := 1 TO CLA8IX DO 
WITH LA8TABMT) DO 
BEGIN 

IF LA8V&L = IVAL THEN « LABEL ALREADY OCCURED ' 
BEGIN 

If labloc^=o Then inS(labloc»ig-2) 

else if chain=0 then begin errorltsm goto 20 

else begin 

CODEl IG-2J1=CHAIN DIV 2 56; 
CODEC IG-1):=CHAIN MOO 256; 



• 



• 
# 



m 

m 



m 

m 



End 
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2942. 
2943. 
2944. 
2945. 
2946. 
2947. 
2948. 
2949. 
2950. 
2951. 
2952. 
2953. 
2954. 
2955. 
2956. 
2957. 
2958. 
2959. 
2960. 
2961. 
2962. 
2963. 
2964. 
2965. 

2966. 
2967- 

2968. 
2969. 
2970, 
2971. 
2972. 
2973. 
2974. 
2975. 
2976. 
2977. 
2978. 
2979. 
2980. 
29B1. 
2982. 
2983, 
2984, 
2985. 
2^85. 

2987. 
2988, 
2989. 
2990. 
2991. 
2992, 
2993, 
2994. 
2995. 
2996, 
2997. 
2998, 
2999. 
3000. 
3001. 



tyPt?^:=i'^tPt'^; 

PCKOt^FALsE 



CHAIN:=IC-2 

END; 
GOTO 20 

Em 

END ; 

" LABEL NOT YET MET, ENTER IT INTO LABELTABLE " 
IP CLABIX = MAXLABS THEN BEGIN ERR0R{74) J GOTO 20 END 
CLABIX := CLABIX + 1 ; 
WITH LABTABCCLABIXI DQ 
BEGIN 

labval:=ivAl; 

LABLOC:=0; 
CHAIN:=IC-2 
END ; 
20: INSYMBOL ; 

END ; 
END " GOTOSTAT "• ; ' 

PROCEDURE WITHSTAT ? 

VAR SAVETOPtSAVETCT: ADDRESS; TATTR:ATTR; 

BEGIN 

SAVET0P:=T0P1 SA VETCT:=TCT; 

UPALIGN(TCT,4} J 

WiTH TATTR 00 

BEGIN 

ALIGNMENT. =^; KiNDj=vARBL. 

BREG:=LEVEL; ACCESS:=dRCT; 

end; 

REPEAT 

INSYMBOL ; 

VARIAB ; 

WITH GATTR do 

IF TYPTR -= NIL THEN 

IF TYPTRS.FORM -»= RECORDS 

BEGIN 

TOP ;= TOP + I ; 

IF TOP > DISPLIMIT THEN ERR0RC82) ELSE 

WITH OISPLAYITOPI DO 

BEGIN 

FMAME := TYPTRa.FSTFLD ; 

IF I ACCESS = DRCT)SC<BREG=OHCBReG = LEVELn THEN 

BEGIN OCCUR := CWITH; 

CDSPL := OPIMT; CLEV .= 8REG; 
END ELSf 
BEGIN tAttR.OpLMTi=TCT; 

LOADADRCGATTR) ; STORE(TaTTR) ; 
OCCUR := Vt^lTH ; VOSPL J= TcT; 
TCT := TCT ♦ 4 ; 

IE TCT > TMAX THEN TMAX := TcT ; 
END 
END 
END 
UNTIL NO -= 15 ; " SY -.= » " 
IF NO -,= 31 THEN 
BEGIN 

IF GATTR. TYPTR ^■= NIL THEN ERR0RC59I ; 

IF NO -.= 31 THEN 

BEGIN 

IF GATTR, TYPTR = NIL THEN ERR0RC59) 
IF ERRCLCNO) = BEGSY THEN GOTO 20 ; 



# 

m 



THEN ERR0R(38) ELSE 



! 

i 
I 

! # 



SKipnii 



GOTO 10 



m 






m 



300 2. 
3003. 
3004. 
3005. 
3006. 
3007. 
3008. 
3009. 
3010. 
3011. 
3012. 
3013- 
3014. 

3015. 
3016. 
3017. 
3018. 
3019. 
3020. 
3021. 
3022. 
3023. 
3024. 
3025. 
302 6. 

302 7- 
3028. 
3029, 
3030. 
3031. 
3032, 
3033. 

3034. 

303 5. 
3036. 
3037. 

3033. 
3039. 
3040. 
3041. 
3042. 
3043. 
3044. 
3045. 
3046. 
3047. 
3048. 
3049. 
3050. 
3051. 
3052. 
3053. 
3054- 
3055. 
3056. 
3057. 
305 8. 
3059. 

3060. 
3061. 



20: 

10: 



END 
END ; 

INSYMBOL ; 
STATEMENT ; 
TOP := SAVETOP; 
END " WITHSTAT " 



TCT := SAVETCT; 



PROCEDURE COMPSTAT ; 
BEGIN REPEAT BEGIN 
INSYMBOL ; 
1: STATEMENT ; 

IF ERRGL(NO) = 
BEGIN eRR0R(58) 
IF NO = 25 THEN 
BEGIN ERR0Rf54) 
END 
UNTIL NO -.= 16 «;" I 
If no ^= 22 THEN "END" 
END "COMPSTAT" ; 



BEGSY THEN 
GOTO 1 END 

"ElsE" 
INSYMBOL ; 



GOTO 1 END 



ERR0RC68J ELSE INSYMBOL 



SHRTINT; 



PROCEDURE STATEMENT 
VAR LPSW,TCHAIN : 
BEGIN 

IF (NO = 2)£!CL = I) THEN "LABEL" 
BEGIN ISTKLIMJ=MAXISTK; ASTKi MAX! STK) :=0; 
IF IVAL >= TW0T012 THEN ERRORUOO) J 
FOR IT := 1 TO CLABIX DO 
WITH LABTABl IT) DO 
IF LABVAL = IVAL THEN "FOUND" 
BEGIN 

IF LA8L3C^=0 THEN «MuLtIDEF»' ERRqrCT?) 
EtSg hfIXUPh 

BEGIN TCHAIN:=CHAIN; 

hhile tchain-.=o do 

BEGIN 

ITl:=C0DECTCHAIN)*256+C00EnCHAIN + U; 
iNSdCTCHAIN); 
TCHAIN:=ITI 
END; 
CHAIN:=TCHAIN; 
LABL0C:=IC 
END; 
GOTO 1 
END "IF, WITH, FOR" ; 
"NEW LABEL" 

IF CLABIX = MAXLA8S THEN 

BEGIN CLABIX :« CLABIX + 

WITH LA8TAB(CLABIX) 00 

BEGIN LABVAL := IVAL ; 

ENID ; 

I INSYMBOL ; 

IF NO -.= 1^ Then «:" 

B^^'In ERROR! 6^1 ? SkiP(49| END ELsE iNsyMgOL ; 
END "IF IN0=2)fJCL=l>" ', 
RP := ; RRP:=0; 
CASE SPLITSTAT<NO) OF 
"PASS " l: "ENDSY OR IRRELSY" ; 
"IDEMT " 2: BEGIN SEARCH ; 

IF CTPTR = NIL THEN 

BEGIN ERROR 131) ; CTPTR := UNOECPTR 



ERROR 174) 

1 ; 



ELSE 



LABLOCi=IG; CHAlNi=0 END 






END 



BffliniM H — l » MlM»W' 



306 2. 

3063. 
3064. 
3065. 
3066. 

3067. 
3068. 
3069. 
3070. 
3071. 
3072. 

307 3. 
3074. 
3075. 
3076. 
3077. 
3078. 
3079. 
3080. 
3081. 
3082. 
30B3. 
3084. 
3085. 
3086. 
3087. 
3088. 
3039. 
3090. 
309 I . 
3092. 
3093. 
3094. 
3095. 
3096. 
3097. 
3098. 
3099. 
3100. 
3101. 
3102. 
3103. 

3104, 
3105. 
3106. 
3107. 
3108. 
3109. 
3110. 
3111. 
3112. 
3113. 
3114. 
3115. 
3116. 
3117. 
3 118. 
3119. 
3120. 
3121. 



"IF 

"CaS^ 
"REPEAT 
"WHILE 
"FOR 
"GOTO 
"WITH 
ENiD ; 
IF ERRC 
BEGIN E 
RP := 
END "STAT 



0: 
1*2,3,4: 

5: 
6: 

7: 

8»9: 

10: 

11: 

END 
END 
ENO E 
END "PR 
END ; 
3: COMPSTAT 
4: IF STAT ; 
5: CASESTAT 
6: REPEATSTA 
7: WHILESTAT 
8: FORSTAT ; 
9: GOTOSTAT 
" 10: WITHSTAT 



WITH CTPTRS DO 

IF KLASS <= KONST THEN eRR0R(55) ELSE 

If {KLASS = PROOe 

ICPROCTYPE = CTPTR) MPROCTYPE = NIL)) THEN 

BEGIN " PROCCALL " 

IF PROCTYPE = CTPTR THEN 

BEGIN INSYMBOL J IF CTPTR8.PRE0EF THEN 
BEGIN LPSW := CTPTRa.SEGSIZE ; 
CASE LPSW OF 
TITLE ; 

GETPUTILPSW) ; 
ALLC ; 
PCK ; 
UNPCK ; 

INSAPPILPSW) ; 
READ I R ; 
MRITEIR ; 



ELSE PASSPARAMS ; 
LSE SKIP{49) 
OCCALL" ELSE ASSIGN ; 



T ; 

9 



L(NO) = IRRELSY THEN 
RR0R(54) ; SKIPI49) END ; 

; RRP:=0 
EMENT" ; 



PROCEDURE SeTsDNAME; 

VAR It Integer; AtARRAYii..iO) of char; 

BEGIN 

IF UNIQINDEX=0 THEM 
BEGIn 

UNPACK(GL08ALNAME»A»1) ; 
A(8):=« •; A<9):=« •; A<10):=« »; 
I: = 7; 

WHILE All:) = « ' DO 
BEGIN A(II:=«$«; I:=I-l END 
END 
ELSE 
BEGIN 

UNPACK I UN IQUENAME , A , 1 ) ; 

A(8) :=UNIQCHiUNIQINDEX MOD 55); 

I:=UNIQINDEX DIV 55; 

IF I-.= THEN 

BEGIN 

A(7): = unIqCHiI m^ 19) ; 

I:=I DIv 19; 

IF 1^=0 Then Af6):=>-'NIQCHCI ) 

Fno 

END; 
PAC<{A,1,UNIQUENAME); 



• 
• 



3122. UNIQINDEX:=UNIQIMOEX+l 

3123. EMD "SETSDNAME"; 
3124. 

3125. PROCEDURE TYPEDECL; 

3126. "RETURNS TL = SIZE OF ITEM, PI POINTS TO TYPE RECORD" 

3127. VAR I,L,LLt J,CV,El,E2tB0ISPL : INTEGER; 

3128. OPT : DPTPWR; OISPL : ADDRESS; PACkFLAG,l£RR : BOOLEAN; 

3129. LASTFLD,PPfP»NXTF,NXTCtNXTA»RTYP : CTP; 

3130. LALIGN: INTEGER; 
3131. 

3132, PROCEDURE SKIPKFNO : INTEGER) ; 

3133, BEGIN 

3134, WHILE ITERRCLtNO) = IRRELSY) & IFNO -.= NO) DO INSYMBOL; 

3135, END "SKIPT"; 
3136. 

3137. PROCEDURE TYPERRt I : INTEGER); 

3138. BEGIN TL := 0; PI := NIL; 

3139. ERRORdI; SKIPT(49); 

3140. END "TYPERR"; 
3141, 

3142. PROCEDURE SUBRANGE(VAR VALl,VAL2 : INTEGER; Nl : CTP; 

3143. CONST P I CTPI ; 

3144. "THE FIRST SYMBOL Of SUBRANGE HAS BEEN READ, 

3145. THE PROCEDURE RETURNS THE TWO BOUND-VALUES IN VAl1,VAL2, 

3146. AND RETURNS Nl = POINTER TO TYPE OF CONSTANTS. 

3147. ERRORS : TYPES 00 NOT AGREE t TYPE IS NQT INTEGER » CHAR, 

3148. OR SYMBOLIC, VALI > VaL2. 

3149. P INDICATES BEGINNING OF SEARCH FOR FIRST SYMBOL IF IT IS 

3150. AN lOf SINCE SEARCH OFTEN ALREADY PERFORMED By CAllEr," 
3l5i, Var N2 : CTP; CKlNDt CONstkIND; 

3152, BEGIN INCONSTCCKINDtNl »P ) ; 

3153, IF (N1=NIL) 1 (Nl=REALPTR) | (N1=ALFAPTR| THEN 

3154, ERR := TRUE ELSE 

3155, BEGIN VAL 1 J= IVAL; INSYMBOL; 

3156, IF NO -.= 19 «:" THEN ERRORCIO) ELSE INSYMBOL ; 

3157, INC0NSTICKIND,N2tNEXT); 

3158, IF Nl -.= N2 THEN ERR := TRUE ELSE 

3159, BEGIN VAL2 := IVAL; 

3160, IF VALl > VAL2 THEN ERROR(25); 

3161, END "Nl = N2"; 

3162, INSYNIBOL; 

3163, END; 

3164, END "SUBRANGE"; 
3165, 

3166, PROCEDURE SUbtyPECvAR I»J : I^StEGS^; P : ^^Tp) ; 

3167, "EITHER A fYPE-lD FOR A SUBRANGE OR AN EXPLICIT SUBRANGE 

3168, ARF PROCESSEO- 

3169, RETURNS I = LOWBOUNO, J = HIGHBOUND, 

3170, P = POINTER TO TYPE OF CONSTANTS " 

3171, BEGIN 

3172, IF NO = 1 THEN "IDENTIFIER" 

3173, BEGIN SRCHRECC NEXT ) ; 

3174, IF CTPTR = NIL THEN SEARCH; 

3175, IF CTPTR = NIL THEN ERR0RC12) ELSE 

3176, BEGIN IF CTPTRi,KLASS = TYPES THEN 

3177, BEGIN IF CTPTRg.FORM > SYMBOLIC THEN ERR0RI13) ELSE 

3178, BEGIN 

3179, CASE CTPTRa,FORM OF 

3180, NuHERiC: BEGIN I := CrpTRa-wlN; J J= CTpTrs.ha^; 

3181, P := INTpTR; 



P 



m 

m 
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3182. 
3183. 
3184. 
3185. 
3186. 
3187. 
3188. 
3189. 
3190. 
3191. 
3192. 
3193, 
3194. 
3195. 
3196. 
3197. 
3198. 
3199. 
3200. 
3201. 
3202. 
3203. 
3204. 
320 5. 
3206. 
3207. 
3208. 
3209. 
3210. 
3211, 
3212. 
3213. 
3214, 
3215, 
3216, 
3217. 
3218. 
3219. 
3220, 
3221, 

3223. 
3224. 
322 5. 
3226. 
3227. 
3228. 
3229. 
3230. 
3231, 

3232. 
3233. 
3234. 
3235. 
3236, 
32 37, 
3238 . 
3239. 
3240, 
3241. 



SYMBOLIC 



EMO; 

BEGIN IF CCTPTR = REALPTRI | ( CTPTR = ALFAPTR) THEN 
ERR0R(6) ELSE 
BEGIN I := ; 

J :=CTPTR3,FCaNSTa, VALUES, I VALUE; 
P := CTPTR ; 
END 

end; 

END "CASE"; 

insyhbol; 

END; 
END "TYPES" ELSE 
IF CTPTR3.KLASS » KONST THEN 

SU'^R*nGE(I,J,P,CTpTr) elSe ERR0RI63) ; 
END; 
ENO "ID" ELSE 
IF (N0 = 2MCNO=7) 
"If mo in SET<2,7}" "CONST +- j " THEN SUBRANGEt I, J,P, NILJ ELSE 
ERR0R{1) ; 
END "SUBTYPE"; 



PROCEDURE SCALOECLCN : CTP); 
BEGIN SUBRANJGECIf JtPPfN); 
IF -»ERR THEN 

IF Ppa,FORH = SYMBOLIC THEN 
BEGIN eRR0R{28); PI := NIL END ELSE 
BEGIN ALLOCCPfTYPES, NUMERIC J; 
WITH Pi DO 
BEGIN NAME := BLANK; NXTEL :- Nl L ; 



• 



# 



:= TYPES; 



FORM :- NUMERIC; MIN 
IF ABSCI ) > ABst Jl THEN 



IF BITS <= 16 
ALIGN := SIZE; 
END; 

TL := Pa, SIZE; PI 
ENO ELSE PI := NIL 
ENO "SCALD5CL"; 



= I; 

BITS 
BITS 
THEN SIZE := 2 



KLASS 
MAX := J; 
:= L0G2«ABSUn 
:= L0G2JA8S(J)) 

ELSE SIZE l^ 4; 



ELSE 



;^ P: 



• 

m 



PROCEDURE FIELDLISTt VAR MAXSIZE : INTEGER ; VARPTR,NXTF :CTP) ; 
"RETURNS MAXSIZE OF FIELO, VARPTR - POINTS TO CASE VARIABLE, 
AND NXTF - POINTS TO THE (CHAINED) FIELDS " 
VAR MXL,L,LL,MINSIZEfCASE8ITS,If J : INTEGER; 
Pf PP,PPlfPP2,NXTC,NXT,CPTR : CTP; 
TAGFLAG : BOOLEAN; 

PROCEDURE RECERRd : INTEGER); 

BEGIN ERRORd); SKIPT{49); END; 

PROCEDURE ADJUST; 

" MOVE LAST FIELD To RIGHT, if it IS THE ONLy FIELD, 
CHANGE TO NONPACKED. 

IF LAST FIELD IS TAGFIELD THEN DO NOT MOVE, 
INCREASE OISPL, RESET 801 SPL " 
BEGIN IF ^TAGFLAG THEN 
WITH LASTFLOa DO 

BEGIN IF BITDISPL = THEN "ONLY ONE FIELO IN WORD" 
BIT WIDTH := ELSE 

BITDISPL := WORDLENGTH - BITWIOTH; 
END; 



3242. DISPL := DISPL + 1; 8DISPL := 0; 

3243. EnjD "ADJUST"; "MAY REQUIRE MODIFICATIONS LATER" 
3244. 

3245. BEGIN "FlELOLIST" 

3246. TAGFlAG := TRUE; NXT := NXTf; 

3247. REPEAT "UMTIL (TERRCL(NO) = ENDSY) S {NO -.= 26)" 
324B. IF NO = 26 THEN "CASE" GOTO 2 ? 

3249. I := O; 

3250. l: IF NO -.= I THEN 

3251. BEGIM RECERRC ID i 

3252. IF TERRCL(NO) = BEGSY THEN GOTO 11; GOTO 12; 

3253. END; 

3254. SRCHREC<^JXT); 

3255. IF CTPTR -.= NIL THEN ERR0R(5) ELSE 

3256. BEGIN ALLOC ( P ,F lELD ) ; I := I + 1; 

3257. WITH Pa DO 

3258. BEGIN NAME := AVAL; NXTEL := NXT; KLASS := FIELD; 

3259. FlDTYPE := NIL; 

3260. Ekjd; NXT := P; 

3261. END; 

3262. INSYHBOL; 

3263. IF NO = 15 THEN "♦" 

3264. BEGIN INSYMBOL; GOTO 1 END; 

3265. IF MO -.= 19 THEN "NOT :" ERROR* 10) ELSE INSYMBOL; 

3266. 11: TYPEDECL(L,P); 

3267. IF P -.= NIL THEN 

3268. IP Pa.FORH > RECORDS THEN ERROROO) ELSE 

3269. BEGIN IF PACKFLAG THEN "NO PACKED RECORDS AT THIS TIHE" 

3270. 8EGIN»IF I > 1 THEN ""REVERSE POINTERS"" 

3271. BEGIN PP := NXT; 

3272. FOR I := I DOWNTO 1 DO 

3273. BEGIN PPl := PPS.NXTEL; 

3274. PPa. NXTEL := PP2; PP2 := PP; 

3275. PP := PPl; 

3276. END; 

3277. NXTa. NXTEL := PPl NXT '.- PP2; 
32'78. END ""REVERSE"" ELSE PP := NXTi-NXTEL; 

3279. PPl := NxT; 

3280. IF pa, FORM <= POWER THEN 

3281. BEGIN 

3282. CASE Pa. FORM OF 
328 3. numeric; LL := PS. BITS; 
3284. SYMBOLIC: LL := Pa.BlTSiZE; 
328 5. POINTER: LL := 18 ; 

3286. POWER: LL := P3.PWBITS; 

3287. END; 

3288. REPEAT 

3289. IF BDISPL ^- LL > WORDLENGTH THEN ADJUST; 

3290. IF LL = WORDLENGTH THEN 

3291. BEGIN PPia.BI TWIDTH := 0; 

3292. PPia.FLOADDR := DISPL; DISPL := DISPL + 1; 

3293. END ELSE 

3294. BEGIN PPia. BITWI DTH := LL; 

3295. »Pia.BITDISPL := BDISPL; 

3296. PPia.FLDAODR := DISPL; 80ISPL := BDISPL + LL; 

3297. END; 

3298. PPia. FLDTYPE := P; 

3299. LASTFLO := PPl; TAGFLAG := FALSE; 

3300. PPl := Ppia.NXTEL; 

3301. UNTIL PPl = PP; 
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12 



2: 



IF 
UNTIL 
IF BO 
NAXSI 
GOTO 
*'CASE 
INSYM 
IF NO 
BEGIN 
IF 
BE 



EMO ""FORH <= POINTER"" ELSE 
BEGIN IF BDISPL -.= THEN ADJUST; 
TAGFLAG := FALSE; 
REPEAT 

PPia.BITWIDTH := O; PPI3.FLDTYPE := P; 
PP13.FLDADDR := OISPL; 
OlSPL := DISPL + L; LASTfLO := PPl; 
PPl := pPia,NXTEL; 
UNTIL PPl = PP; 
END; " 
END "PACkFLAG« ELSE 
BEGIN LL := PS.ALIGN; 
IF LL > LALI6N THEN 
UPALTGNCDISPLtLL) ; 
LL := OISPL + I*L; 
P? := NXT; 
FOR I := I DOWNTO 1 
BEGIN PPS.FLDTYPE := P; LL i= LL - L; 
PP3.FLDADDR := LL? PPa,BITWIDTH := O; 
PP3, ALIGN:=P3.ALIGN; PP := PPa.NXTEL; 
END; 
END; 
END "FORM <= RECORDS"; 
m = 16 «;» THEN INSYMSOL; 

CTERRCLCNO) = ENDSY) G JNO -i= 26 "CASE" 1; 
ISPL -.= THEN ADJUST; 
IE := DISPL; VARPTR := NIL; 
9; 
•« 



LALIGN := LL; 
UPALIGN<LfLL) 
DISPL := LL; 

DO 



m 

m 



EN 
IN 

END " 

IF 
IF 

BE 



NUMERIC: 
SYMBOLIC 



bol; 

-.= I THEN £ 
SRCHREC{NXT 
CTPTR ->= HI 

GIN ALLOCCP, 
WITH pa DO 
BEGIN NAME 
FLDTYPE 
END; NXT : 

o; 

SYMBOL; 

NO = I"; 

H3 -= 19 ": 

H3 -= 1 The 

GIN SRCHrSC( 
IF CTPTR = 
IF CTPTR = 
IF {CTPTR3. 
"{-.NUMER 

insynbol; 

IF NO -.= 
CPTR := 
IF CPTR 
IF PACKF 
BEGIN " 
CAS 
L 
L 
END 
IF 
PS. 



RRORCllJ ELSE 

); 

L THEN ERR0R(5I ELSE 
FIELOl; 

:= aval; NXTEL := NXT; KLASS : 
;= NIL; 
= p; 



FIELD; 



• 



" THEN ERRORilOl ELSE INSYMBOL; 

N ERRORCllJ ELSE 

N^XT); 

NIL THEN SEARCH; 

NIL THEN ERR0RC12I ELSE 

KLASS-.=TYPES) I t CTPTR3.F0RH>SYMB0LIC) THEN 

IC) S {-.SYMBOLIC)" ERR0RI7); 

27 "OF" THEN ERR0R(i4); 
CTPTR; 
-.= NIL THEN 
LAG THEN "NO PACKED RECORDS AT THIS TINE" 

E CPTRa.FORM OF 
L := CPTRa.BITS; 
L := CPTRS.BITSIZE; 

• 

BDISPL + LL > WORDLENGTH THEN ADJUST; 
BITDISPL := BDISPL; Pa.BlTWIDTH := LL; 
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BDISPL := BDISPL + LL: 
:= BDISPL; " 



P3.FLDA0OR := DISPL; 

LASTFLO := P; CASE8ITS 
EMD "PACKFLAG»' ELSE 
BEGIN IF CPTR3. ALIGN > LALIGN THEN LALIGN := CPTRi. ALIGN; 

UPALIGN(DISPLtCPTRa.ALIGN); 

P3.FLDADDR := OISPL? 

Pa.BITWlDTH := 0; 

Pa.ALlGN:=CPTR3.ALIGN; 
END; 

Pa.FLOTYPE := CPTR; DI SPL 
MINSIZE := DISPL; MAXSIZE 

NXTC j= nil; insymbol; 

REPEAT I := 0; 
REPEAT 

" IF (N0>2J j {N0=2) 6 -.(CL IN SETCl,4n THEN" 
IF CNG>2) I (N0=2) £ -.{ (CL=1) M CL=4n THEN 

"HAS TO BE NUMERIC OR CHAR CONSTANT DR ID" 



f 

m 



DISPL 
OlSPL; 



+ CPTRa.SIZE; 



BEGIN RECERRC63} 



GOTO 3 END 



IF CPTR -* NIL THEN 
IF NO = I THEN 
BEGIN SRCHRECCNEXT); 

IF CTPTR = NIL THEN SEARCH; 

IF CTPTR = NIL THEN ERR0R(12) ELSE 

WITH CTPTRa 00 

IF KLASS -11= KONST THEN eRR0Rr63) ELSE 
IF (CPTR3.F0RM = SYMBOLICI £ 
CCONTYPE -.= CPTR) I 
CCPTR3.F0RM = NUMERIC) £ 

(CQNTYPE -»= INTPTR) THEN ERR0R{73) ELSE 
IT := VALUE S.I VALUE; 
END "NO = I" ELSE 

IF iCL = 1) £ CCPTRS.FORH ^= NUMERIC) 
I (CL = 4) S ICPTR -.= CHARPTR) THEN 
ERROR (73 1 ELSE 
IT := IVAL; «EN0 CPTR -•= NIL" 
ALLOC(P,TAGFIELD); 
WITH PS DO 

BEGIN NAME := BLANK; NXTEL :=. NXTC; 
KLASS := TAGFIELD; 
TAGVAL := TRUE; CASEVAL := IT; 
END; NXTC := P; I := I + I; 
INSYMBOL; 

IF NO -•= 19 THEN ERRORUO) ELSE INSYMBOL; 
UNTIL NO > 2; 

IF NO = 9 THEN " ( FIELOLIST ) » 
BEGIN IF PACKFLAG THEN "NO PACKED RECORDS NOM" 
BEGIN "DISPL := MINSIZE - l; 

BDISPL := CASEBITS; " 
END ELSE DISPL := MINSIZE; 
INsyHBOL; FIELOLlSTiMXL,PP,NXT» ; 
IF NO -= 10 THEN ERROR (9) ELSE INSYMBOL; 
END ELSE 

BEGIN PP := NIL; HXL := HINSIZE END; 
P := NXTC; 

FOR I := I OOWNTO I DO 
WITH P3 DO 
BEGIN CASeSIZE := MXL; VARIANTS := PP; 

P := NXTEL; 
END; IF MAXSIZE < MXL THEN MAXSIZE := MXL; 
IF NO = 16 THEN INSYMBOL; 



m 
m 
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UNTIL NO > 2; 
ALLOC{P,TAGFIELD) ; 
WITH pa DO 

BEGIN NAME := BLANK; NXTEL := NIL; KLASS 
CASESiZE := MINSIZE; VARIANTS := NXTC; 
TAGVAL := FALSE; CASETYPE := CPTR; 
END; 

VARPTR := P; 
EMO ••N!G = I"; 
NXTE := NXT; 
END " FIELOLIST "; 



tagfield; 



••TYPEOECL" 

BEGIN PACKFLAG 



if no 
begin 

if no 

begin 

if 

IF 



false; lalign 

"NO 



J— Q • 

packed 



RECORDS AT THIS TIME" 



INSYMBOL END; 



» SYMBOLIC 

LERR := ERR 



ERR := FALSE; ALLOC IP, TYPES, SYMBOL IG) 



NXTEL := NIL; KLASS := TYPES 



2: 



= 42 THEN "PACKED" 
PACKFLAG := "TRUE" FALSE 
= I THEN 

srchreccnext); 

ctptr = nil then search; 

ctptr = nIl then 
begin err0r(12); pi := nil; skipt{16) end else 
begin if ctptr3. klass = types then "type-id" 

BEGIN TL := CtPTRS.SUE; Pl := CTPTR; INSYMBOL END ELSE 
IF CTPTRa. KLASS = KONST THEN SCALDECL (CTPTR ) ELSE 
TYPERRdU; 

END; 
END "ID" ELSE 
IF NO = 9 THEN 
BEGIN CV := 0; 
WITH P3 DO 
BEGIN NAME := BLANK: 
FORM := SYMBOLIC; 
end; RTYP := P; NXTC := NIL; 
REPEAT INSYMBOL; 
IF NO -.= I THEN 
BEGIN ERROR(ll); SKIPTC15); 

GOTO 2; 
END; 
SRCHRECCNEXTI; 

IF CTPTR -.= NIL THEN ERR0RI8J ELSE 
BEGIN ALLQCCp, KONST, ACTUAL) ; 
WITH P3 DO 

BEGIN NAME ;= AVAL; NXTEL := NEXT; KLASS i» KONST; 
CONTYPE := RTYP; CONKIND := ACTUAL; 
VALUES.KONSTKIND:=SYMBOLIGS; 
VALUES. 1 VALUE :=CV; SUCC:=NXTC; 
END; CV :== CV ♦ l; NEXT i= P; NXTC := P; 
END; 

INSYMBOL; 
UNTIL NO -.= 15; 

ALLOC(P,TYPEStPOWER) ; 
WITH Pa DO 
BEGIN NAME := BLANK; NXTEL := NIL; KLASS := TYPES; 

SlZE:=4; ALIGN:=4; "CHANGE HERE FOR DIFF SIZE PWSET" 

FoRm := POWER; ELSE? := RTYP; PWSlTS := CV + I; 
END; 

WITH RTYPa DO 
BEGIN FCONST := NEXT; 

BITSIZE := L0G2{CV - I); PWSeT := P; 

IF CV-l < HAXHALF THEN SIZE := 2 ELSE SIZE :- 4; 












3482. ALIGN := SIZE; 

3483. END; 

3484. IF ERR THEM PI : = NIL ELSE 

3485. BEGIM ERR := LERR ; PI := RTYP END ; 

3486. TL := RTYP3.SIZE ; 

3487. IF NT -'= 10 THEN TYPERR(9) ELSE INSYMBOL ; 

3488. END •' SYMBOLIC " ELSE 

3489. "IF NO IN SeT(2»7) THEN"" SUBRANGE " 
3490- IF <N0 = 2H{N0=7i THEN " SUBRANGE " 

3491. SEGIf^ LERR := ERR; ERR := FALSE; 

3492. SCALOECL(NEXT); 

3493. IF ERR THEN ERR0R(6) ELSE ERR := LERR 

3494. END "SUBRANGE" ELSE 

3495. IF N3 = 38 THEN " STRUCTURED TYPES " 

3496. CASE CL OF 

3497. "ARRAY" I: 

3498. BEGIM INSYMBOL; 

3499. IF NO -.= 9 "I" THEN 

3500. BEGIN TYPERR(98); 

3501. IF TERRCLCNO) = BEGSY THEN TYPEOECLC TLt CTPTRJ; GOTO 19; 

3502. END; 

3503. NXTA := NIL; 

3504. REPEAT ALLOC( P , TYPES, ARRAYS J ; 

3505. WITH P3 DO 

3506. BEGIN NAME := BLANK; NXTEL t- NIL; KLASS J= TYPES; 

3507. FORM := ARRAYS; AELTYPE := NXTA; 

3508. " AELTYPE TEMPORARILY LINKS SUBARRAYS « 

3509. END; NXTA := P; 

3510. INSYMBOL; 

3511. LERR := ERR; ERR := FALSE; 

3512. SUBTYPEMfJfP); 

3513. IF ERR THEN 

3514. BEGIN ERR0R(6}; SKIPT(15); I := 0; J := 0; P := NIL 

3515. END ELSE 

3516. ERR := LERR; 

3517. !^ITH NXTA3 00 

3518. BEGIN LO := I; HI := J; INXTYPE J- P END; 
3519. 
3520. 
3521. 

3522. IF TERRCLfNOI = BEGSY THEN GOTO 11 
3523. 
3524. 

352 5. 

3526. BEGIN Pl := NIL ; TL := O; GOTo 19 END; 

3527. 

3528. 

3529. IF NO -.= 27 THEN ERR0R114) ELSE INSYMBOL 

3530. 11: TYPEOECL(TL,CTPTR); 

3531. IF CTPTR -»= NIL THEN 

3532. IF CTPTRa.FORM > RECORDS THEN 

3533. BEGIN ERR0Rf30); CTPTR := NIL END ELSE 

3534. BEGIN UPALIGNCTL,CTPTRa. ALIGNJ ; 

3535. "CHANGE HERE FOR PACKED ARRAYS" 

3536. REPEAT 

3537. WITH NXTAa DO . 

3538. BEGIN MULOPTC TLt El ,E2,0PT) ; 

3539. GPTTYP := OPT; EXPl :* El; EXP2 := E2; 

3540. TL := TL*{HI - LO + 1); 

3541. SIZE := TL ; 



m 



• 
• 
• 

m 



UNTIL 


NO 


-.= 15; 




IF NO 


-»-— 


10 "1" THEN 


BEGIN 


ERROR (37); SKIPTI27); 


IF 


TERRCLtNOI = 


BEGSY THEN 


IF 


NO 


= 27 THEN 




BEGIN 


INSYMBOL; 


GOTO 11 EN 


If 


NO 


-,= 10 ")« 


THEN 


BEGIN 


Pl := NIL 


; TL := o; 


END; 








INSYMBOL; 






IF 


NO 


-.= 27 THEN ERR0R114) 



m 
m 



3542. P := AELTYPE; AELTYPE := CTPTR; 

3543. ALIGN := CTPTRa. ALIGN; 

3544. end; 

3545. CTPTR := NXTA; NXTA := P; 

3546. UNTIL NXTA = NIL; 

3547. " NOW TL = SIZE OF APRAYt CTPTR POINTS TO IT " 

3548. end; pi := CTPTR; 
354^. 19: END "ARRAY"; 

3550. "RECORD" 2: 

3551. BEGIN ALLOC ( P, TYPES, RECORDS) ; 

3552. WITH PS DO 

3553. BEGIN NA^^E := BLANK; NXTEL := NIL; KtASS '.= TYPES; 

3554. FORM := RECORDS; 

3555. END; RTYP := P; 

3556. INSYMBOL; NXTF := NIL; 

3557. DISPL := 0; 3DISPL := 0; LERR := ERR; ERR := FALSE; 

3558. FIELDLISTCTLfPfNXTF); 

3559. IF MO -.= 22 THEN ERROR! 17 J; 

3560. IF ERR THEN TYPERRCiS) ELSE 

3561. WITH RTYPa DO 

3562. BEGIN SIZE := TL ; FSTFLD := NXTF; RECVAR := P; 

3563. PI := RTYP; ERR := LERR; INSYMBOL; 

3564. ALIGN i= LALIGN; 

3565. END; 

3566. END "RECORD"; 

3567. "FILE" 3: 

3568. BEGIN INSYMBOL; 

3569. IF MO -.= 27 THEN ERR0R(14) ELSE INSYMBOL; 

3570. TYPEDECLCTLfCTPTRl; 

3571. IF CTPTR -.= NIL THEN 

3572. If CTPTRa. FORM > RECORDS THEN 

3573. BEGIN ERR0Rf30); Pl := NIL END ELSE 

3574. BEGI^4 ALLDCI P, TYPES, FILES) ; 

3575. WITH Pa DO 

3576. BEGIN NAmE := BLANK; NXTEL := NIL; KLASS := TYPES; 

3577. F3RM:=FILES; SI ZE t=CTPTRa. SIZE+16 ; FELTYP£:=CTPTR; 

3578. IF CTPTRa. ALIGN<=4 THEN ALIGN:=4 

3579. ELSE AL lGN:=CTPTRa. ALIGN ; 

3580. TL:=SIZE; 

3581. END; 

3582. PI := P; 

3583. END ELSE PI := NIL; 

3584. END "FILE"; 

3585. "CLASS" 4: 

3586. BEGIN ALLOC ( P , TYPES, CLASSS) ; 

3587. WITH Pa DO 

3588. begin name := blank; nxtel := nil; klass ;= types; 

3589. form := classs; 

3590. End; 

3591. insymbol ; 

3592. if (mo = 2)£<cl = 1) then 

3593. BEGIN I := IVAL ; INSYmBOL END ELSE 

3594. I := 100 ; "DEFAULT CLASS SfZE" 

3595. IF NO -.= 27 THEN ERR0RI14) ELSE INSYH80L; 

3596. TYPEOECLCTL, CTPTR); 

3597. IF CTPTR -.= NIL THEN 

3598. IF CTPTR3.F0RM > RECORDS THEN 

3599. BEGIN ERR0R(30); PI := NIL END 

3600. ELSE WITH PS DO 

3601. BEGIN iJPALIGNCTL,CTPTRa,ALIGN) ; 
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"CHAMGE HERE FOR PACKED CLASSES" 
TL := TL*I+8; "8-BYTE CLASS DESCRIPTOR" 
SIZE := TL; PELTYPE := CTPTR; 
IF CTPTR3.ALIGN<4 THEN ALIGN:=4 
ELSE ALIGN:=CTPTRS.ALIGN; 
Pl := P; 
END 
ELSE P1:=NIL; 
EMD "CLASS"; 
"POWERSET" 5: 

3EGIM INSYMBOL; LERR := ERR; ERR := FALSE; 
SUBTYPE{I,J,P) ; 
IF ERR THEN TYP£RR(6» ELSE 
BEGIM ERR := LERR; 
CASE Pa. FORM OF 



• 



NUMiERIG: 



> WORDLENGTH - 
PI := NIL END 



SYMBOLIC: 



< 0) I (J 

ERR0R(6}; 

:= PNUMPTR; 

IF P = ChArptr THEN j 

J > wOJ^DLeNgtH - 2 THEN 



2) THEN 
ELSE 



- WOROLEMGTH - 2 



IF (I 

BEGIN 

PI 

BEGIN 

IF 

BEGIN ERR0RC6); PI := NIL END ELSE Pl := Pa.PwSET; 
END; 
ENID "CASE"; 
TL := 4; "CHANGE FOR 
IF -.ERR THEN PIS, SIZE 
END "-.ERR"; 
END "P3WERSET"; 



"??????" 



DIFFERENT 
;=4; 



SIZE PWRSET" 



TYPES" ELSE 
"POINTER" 



TYPERRdll ELSE 

ALL OC ( P , TYPE S , POI NTER ) 



NXTEL ' 
SIZE := 



= NIL; KLASS := TYPES; 
4; ALIGN := 4; 



END "STRUCTURED 
IF NO = 18 THEN 
BEGIN INSYMBOL; 

IF MO -= I THEN 
BEGIN TL := 4; 
WITH PS 00 
BEGIN NAME := BLANK; 

FORM := POINTER; 
END; 
SRCHREC(NEXT); 

IF CTPTR = NIL THEN SEARCH; 

IF CTPTR -= NIL THEN 

IF CTPTRS.VTYPE = NIL THEN CTPTR :^ NIL; 

IF CTPTR = NIL THEN "UNDECLARED CLASS" 

IF PTx > PTLIMIT THEN 

BEGIN ERR0R{92); Pl := NIL; INSYMBOL END ELSE 

WITH PTLIST(PTX) , Pa DO 

BEGIN HNAME := AVAL; PPTR := P; 

DOMAIN := P; ELTYPE := P; 

PTX :* PTX + l; Pl := P; INSYMBOL; 
END ELSE 
WITH CTPTRi 00 

IF ULASS = VARS) £ fVTYPE3.F0RM = CLASSS) THEN 
BEGIN Pa. DOMAIN := CTPTR; 

Pi. ELTYPE := VTYPES5.PELTYPE; 

Pl := P; INSYMBOL; 
END ELSE TYPERRC 15) ; 
EN}0; 

END "POINTER" ELSE TYPERRC18I; 
END "TYPEOECL"; 

PROCEDURE BODY; 
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"SURRPTR - SURROUNDING PROCEDURE, FIRSTENTRY - DUMMY USED 

TO RESET C0NTESTTA8LE AND MAKE LOCAL VARIABLES DISAPPEAR" 



LABEL l; 

VAR I, J : INTEGER; 
QLDLEV : RG3; 

LC1,TL»LL,FSTIX,LCA,LCP : INTEGER 5 
Nj,P,pRoCpTR,LFlRSTENTRY,SPTR : CTP ; 

typid : alfa ; lch : cword ; kkino: 
vlcmlcjaooress; 



CONSTKIND; 



PROCEDURE FINOSEMICOLON; 
BEGIN IF NO -.= 16 THEN 

BEGIN ERROR( 58) ; SKIP(16); 

IF NJO -.= 16 THEN GOTO EXIT I; 

END; insymbol; 
END "FINIDSEMICOLQN"; 

PROCEDURE WRITVAL1 

VAR VLEN,IT,rTl:INTEGER; VTYP,ETYP:CTP; 

I.ESDI0,J,LIC,AMT:SHRTINT; K: INTEGER; 

PROCEDURE STCONS; 

VAR IiSHRTINT; ATEMP: ARRAy(l..l0) OF CHAR; IXMNTEGER; 

BEGIN FOR I:=l TO 10 00 ATEMP<ll:=» ♦; 

CASE KKIND QF 

INTEGERS, SYMBOLICSf CHARS: 

IF VLEn=10 THEN ATEMP< 1) :=CHR< I VAL) 

Else bggin ix:=ival; 
for i:=vlen downto i 00 

BEGIN ATEMP{ n:=CHR( IX MOO 256}; 

IX:=IX DIV 256 
END 
END; 
REALS: BEGIN END; «HELP - WHAT 00 WE DO???" 
ALFAS: UNPACK(AVAL»ATEMIPfli ; 
END; "CASE" 

FOR l: = TO VLEN-l DO CODEC IC^U :=INT(ATEMP{ I + IU ; 
IC:=IC+VLEN 
END "STCONS"; 

BEGIN 

vData:=true; 

PASCALG03:=BLANKCARD; PASCALg03(1) ;=CHR(2) ; 
"ONLY ESD item IS CSECT NAME" 
U">JPACK(«ESD' ,PASCALG0S»2I; 

PASCALG03(li):=CHR<0) ; PASCAlG03( 12) :*CHR( I6l ; 
PASCALGOaC 15):=CHR<0J ; PASCALG03U6) :=CHRC1) ; 
UNPACK.(V$gBL0AT',PASCALGO3,17) ; 
FOR I:=25 TO 28 DO PASCALGOit I) 

DO PASCALGOSd) 



m 



:=CHRiO} ; 
:=CHRC0l; 



FOR I:=30 TO 32 

put{pascalgo); 

insy^^bol; 
while n0=1 do 

BEGIN 

SRCHRECCNEXTI; 

IF CTPTP=NIL THEN SEARCH; 

IF CTPTR=NIL THEN BEGIN ERR0RC12}; FINOSEMICOLON; 

IF CTPTRa.KLASS-»=VARS THEN 

BEGIN eRR0R(26}; FINOSEMICOLON; GOTO 20 END; 
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GOTO 20 END; 
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3754. 
3755. 
3756. 
3757. 
3758. 
3759. 
3760. 
3761. 
3762. 
3763, 
3764. 
3765. 
3766. 
3767. 
3168. 
3769. 
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3771. 
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3773. 
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3777. 
3778. 
3779. 
3780. 
3781. 



SIZE; 



INSYMBOL 



VLEN:=ETYPa.SI7.E END 



ELSE 



TIMES IF IT1=1" 

CODEUC + Ii :=CODE(IC-VLENI+I) 



IT:=CTPTRa.VAODR; IC:=0; 
IF IKMLC THEN MLC: = IT; 
VTyP:=CTPTRa.VTYPe; VLEN:=VTYPi. 

insymbol; 

if(m0-.= 8j|(cl-.=6) then err0r(4) else 

IF Na=9 •«{" THEM "LIST" 
BEGIN 

IF VTYP3.FGR'»4=ARRAYS THEN 
BEGIM ETYP:=VTYPa.AELTYPE 
ELSE ERR0R(27); 
REPEAT INSYMBOL; 

IMC0NST(KKIN0,PT,NEXT»; 
IM SYMBOL; 

lTi;=l; 

IF (N0=6)&|CL=1J THEN "*" 

BEGIN 

if kkino=integers then it1:«ival 

insymbol; 

INCONSTlKKlND,PTtNEXT) ; 

INSYMBOL; 

end; 

IF -.ERR THEN 
BEGIN 
STCONS; 

FOR Jt=0 TO IT 1-2 DO "0 
BEGIN 

FOR I:=0 TO VLEN-1 DO 
IC:=IC+VLEN 
END 
END; 

IF (NO-.= 15)raNO-.= lO) THEN 

BEGIN ERflOR(20i; f INOsEMiCOlqn; GOTO 20 ^NO; 
UNTIL N0=10; 

Insymbol 

END «N0=9" 

ELSE 

BEGIN 

INCONSTlKKINDfPTtNEXT) ; 

INSYMBOL; 

IF -nERR THEN STCONS 
END; 

IF IC+IT>VLC THEN VLC:=IG+IT; 
"WRITE OUT TEXT CARDS" 
UNPACKl 'TXT* ,PASCALG0a,2) ; 
PASCALGOai 13):=« •; PASCALGOa{ 14) :=' •; 
PASCALGOat 15) :=CHR{0) ; PASC ALG0aC16 ) :=CHR{1) ; 
PASCALGoaJ IU:=CHR{0) ; 
LIC:=0; 

WHILE LIC<IC DO 
BEGIN 

IF IC-LIG>=56 THEN AHT:=56 ELSE AMT:=IG-LIG; 

K:=IT+LIG; 

PASCALG0a(6l:=CHR(K DiV 65536); 

PASCALG0a!7j:=CHRCK MOD 65536 DIV 256); 

PASCALGOa(S):=CHR(K MOD 256); 

PA5CALG0aM2):=CHR{AMT) ; 

FOR I:=LIC TO LIC+AMT-1 DO PASCALGOaC I-LIG+17) 

FOR I:=AMT+17 TO 72 DO PASCALGOaC U :=* »; 

LIG:=LIC+AMT; 

PUTiPASCALGO); 
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= CHR(COD£in) 
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END; 

findsemicolon; 

20: ENID; 

PASCALG0a: = 8LA!\)KC/\RD; PASCALGOa(l) :=CHR(2) ; 
UNPACKS 'END'tPASCALGOafai; 

PASCAL Ga3( 29) :=CHft(0) ; PASCALGOaC 30) :=CHR(VLC 
PASCAL Gi)S)<31):=CHR{VLC MOD 65536 OIV 256); 
PASCALG03<32):=CHR(VLC MOD 256); 
PUT(PASCALGn) 
END "WRITVAL"; 



DIV 65536) 



• 



PROCEDURE VAROECL; 
LABEL 10; 
VAR AT : ADDRESS; 

PROCEDURE FILERR; 
BEGIN ERR0R{95); 



I,J 



SHRTINT 



SKIP* 12); GOTO EXIT 10 END 



ELSE 



:= NEXT; 
:= NIL; 



+ I 



SETI IN,OUT,PRINTtPUNCH ) 

= 7) THEN «IN" 
ELSE 



BEGIN INSYH80L; SPTR := NEXT; 
WHILE NO = 1 DO 
BEGIN I := 0; 
REPEAT 

SRCHRECJNEXT); 

IF CTPTR ^= NIL THEN ERR0R(8) 

BEGIN ALLOC(P,VARS) ; 

WITH pa DO 

BEGIN NAME := AVAL; NXTEL 
VKINO := actual; VTYPE 
VLEVEL := ; 
END; 

NEXT := P; I := I 
END; 

insymbol; 

if no = 9 «{" then " 

begin insymbol; 

IF INO = 81 6 (CL 
Pa. VLEVEL := 4 

If NO = I THEN 

IF AVAL = »OUT» THEN 

P3. VLEVEL r= 1 ELSE 
IF AVAL = *PRINT« ThEN 

PS. VLEVEL :== 2 ELSE 
If AVAL = • PUNCH » THEN 

pa. VLEVEL 1= 3 ELSE FILERR 

insymbol; if no -.= ig " ) " then 

insymbol; 
end; 
err :•= false; 

IF NO = 15 "," THEN 

BEGIN insymbol; 

IF NO -.= 1 THEN 

BEGIN ERRORCll); SOTO 10 END; 

END ELSE IF NO -.' 19 ":" THEN ERRORaO) 
UNTIL NO ^= I ; 
If NO = 19 ":" THEN INSYMBOL 

ELSE IF -.ERR THEN ERRORUO) ' 
N := NEXT; ERR := FALSE; 
TYPEDECLCTL, CTPTR) ; 
IF ERR THEN GOTO 10; 
IF CTPTR -.= NIL THEN 



• 



KLASS 
ALIGN : 



= VARS; 

■■ 0; 



ELSE FILERR 
FILERR; 



# 
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3842. BEGIN 

3843, IF !>1 THEN UPALIGN(TL»CTPTR8. ALIGN) ; 
3B44, UPALlGNdCCTPTRa. ALIGN) 

3845, END; 

3846. LC := LC + I*TL; LL := LC; 

3847. FOR I := I DOWNTO I DO 

3848, WITH NS DO 

3849. BEGIN LL := LL - TL; 

3850. VTYPE := CTPTR; 

3851, IF CTPJR -= NIL THEN 

3852. BEGIN ALIGN J= VTYPEa.ALiGN; 

3853, VLEVEL:=LeVEL| VADDR:=LL; SSI ZE :=CTpTRa. SI ZF; 

3854, IF CTPTRa.FORM = ClASSS THEN 

3855. BEGIN " CHECK FOR PREDECLAREO CLASS ♦• 

3856. TYPIO := NAME? P := CTPTRa.PELTYPE ; 

3857. IF PFTOP = FILLIMIT THEN ERR0R{92I ELSE 

3858, BEGIN PFTOP := PFTOP + 1; 

3859, PFL(PFTOP) :=LL; PEN0( PFTOP) :=LL+TL 

3860, END; 

3861, FOR J := PTX - 1 DOWNTO DO 

3862. WITH PTLISTIJ) DO 

3863, IF HNAME = TYPID THEN 

3864, BEGIN PPTR3. DOMAIN := N; 

3865. PPTR3.ELTYPE := P; 

3866. PTX := pTX - l; 

3867. HfsjAME := PTLI STc pTX>.hNAME ; 

3868. PPTR := PTLIST(PTX).PPTR; 

3869. END " WITH, Fqr « ; 

3870, HMD " CHECK CLASS " ELSE 

3871, IF CTPTRa.FORM = FILES THEN 

3872, IF FILTOP = FILLIMIT THEN ERRORt92) ELSE 

3373. BEGIN FILTOP := FiLTOP + I; FILPTSC FILTOP ) := N END 

3374. END "CTPTR -^= NIL" I 

3875. N := NX TEL; 

3876. END " FOR I " ; 

3877. 10: FINOSEM ICOLON; 

3878. e^^O "WHILE NO = 1"; 

3879. IF NjO = 47 THEN " VALUE " 

3880. BEGIN IF LEVEL -= THEN ERR0R{22); 

3881. WRITVAL 

3882. END "VALUE"; 

3883. END " VARDECL " ; 
3884. 

3885. PROCEDURE FoRMPARM; 

3886. " ( HAS BEEN VERIFIED AND NEXT SYMBOL READ " 

3887. LABEL 3; 

3888. VAR SPEC : IDClaSS; REP : BOOLEAN; 

3889. I:SHRTINT; LL:AODRESS; 
3890. 

3891. PROCEDURE FORMERR ; 

3892, BEGIN ERRORIll); SKIP(IO); GOTO EXIT 3 END; 
3893. 

3894, BEGIN SPEC := KONST ; 

3895, l: REPEAT l:=0; 

3896, IF MO = 45 THEN "PROCEDURE" 

3897, REPEAT IN SYMBOL; 

3898, IF NO -r= 1 THEN ERRORUl) ELSE 

3899, BEGIN SRCHREC ( NE XT) ; 

3900, IF CTPTR -.= NIL THEN ERRORCSI ELSE 

3901, BEGIN ALLOC(P,PRnC); 
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3902- 
3903. 
3904. 
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3906. 
3907. 
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3914. 
3915. 
3916. 
3917. 
39l8, 
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3931. 
3932. 
3933. 
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3942. 
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3952. 
3953. 
3954. 
3955. 
3956. 
3957. 
3958. 
3959. 
3960. 
3961. 



WITH pa DO 

BEGIN NAME := AVAL; NXTEL := NEXT; KLASS := PROC; 
PROCTYPE := P; PROCKIND := FORMAL; 
PROCLEVEL := LEVEL; 
FORMAL S := MIL; 
END; LC := LC *• 4; NEXT := P; 
EMD "CTPTR = NIL"; 
IMSYMBOL; 

end; 

UMTIL NO -= 15 

ELSE "NOT PROCEDURE" 

BEGIN 

IF NO -= 1 THEN 

BEGIN IF NO = 43 THEN S^EC := VARS ELSE 
IF NO = 41 THEN SPEC := KONST ELSE 
IF NO = 44 THEN SPEC := PROC ELSE 
FORMgRR; 

insymbol; 
£nio else if spec -» vars then spec := konst ; 
if no -= 1 then formerr; 

REPEAT 

SRCHREC(NEXT); 

IF CTPTR ^= NIL THEN ERR0R{8) ELSE 

BEGIN 

CASE SPEC OF 
KONST: BEGIN ALLOC! P , KONST, FORMAL) ; 

WITH Pa 00 
BEGIN CONTYPE l= NIL; CONKIND := FORMAL; 

I:=I+l; CLEVEL := LEVEL; 
END; 
END; 
PROC: BEGIN ALLOCtP,PROC 1; 

WITH pa 00 

BEGIN PROCTYPE := NIL? PROCKIND := FORMAL; 

UPALlGNCLCt^); 

PROCADOR := LC ; PROCLEVEL := LEVEL; 

FORMA LS := NIL; ALIGN: =4; 
END; 

LC:^LC+4; 
END; 
VARS: BEGIN ALLOC(P, VARS) ; 

WITH pa 00 
BEGIN VTYPE := NIL; VKIND := FORMAL; 

UPALIGNILCf4) ; VLEVEL := LEVEL; VADOR := LC; 

ALIGN :=4; 
END; 

LC:-LC+4; 
END; 

End »«CAse"; 

Pa-N^ME := AyALj Pa-NXTEL := NE^T; 

P8. KLASS := SpEC; 

NEXT := P; 
END "CTPTR = NIL"; 
INSYMBOL; 
IF NO = 15 THEN 
BEGIN INSYMBOL; 

IF NO = 19 THEN ERROR (11); 
END ELSE IF NO -.= 19 THEN GOTO 4; 
UNTIL NO -.= l; 
4: IF NO -1.= 19 THEN ERRORCIOI ELSE INSYMBOL; 
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4014. 
4015. 

4016. 
4017. 

4018. 
4019. 
4020. 
4021- 



PROC' 



vArS: 



(F0RM-.=NUMERIC)6{F0RM-i.= SyMB0LIG) 



LL:=LC END 



IF HO -.= I THEN FORMERR; 

search; 

if ctptr = nil then 

begin) err0r(12); goto 2 end; 

ie ctptra.klass -.= types then 

begin errords) ; goto 2 end : 

N := NEXT; 
WITH CTPTRa DO 
IF SPEC=KGNST THEN IF 
&(FORN^=POWER) THEN 
BEGIN TL:=4; UPALIGNC LC,4J ; LC :=LC-»-I*4; 

else begin up alignc lc, align) ; tl:=size; 
upalign<tl»align); lc:=lc+i*tl; ll:=lc end; 

REPEAT 

CASE SPEC OF 
KONST: IF Na.CONTYPE = NIL THEN 
BEGIN 

ll:=ll-tl; 

WITH TTPTRS 00 

IF(F0RM-^=NUMeRIG)K<F0RM-=SYM80LlC|S{F0RM^=P0wER) THEn 
BEGIN 

Ni.KLASS:=VARS; Na.ALlGN:=4; 

If F0RM=P0INTER then N3.VKIND:=ACTUAL 

ELSE N3.vkino;=formal; 

N3.VTYPE:=CTPTR; N3. VADDR:=LL; NS. VLEVEL:=LEVEL; 
END 
ELSE 
BEGIN Na.ALIGNi=ALIGN; 

N3.C0NTYPE:=CTPTR; Na.CAOOR:=LL; 
END; 

N:=Na,NXTEL; 
END ELSE N := NIL; 
IF Na.PROCTYPE = NIL THEN 

IF CTPTRa. FORM > POHER THEN 






N := Na. nxtel; 



BEGIN ERR0R193); N := NIL END 
BEGIN Na.PROCTYPE := CTPTR; N 
ELSE N := NlL; 
If Na»VTYPE = NIL THEN 
BEGIN Na.ViYPE := CTPTR: 
END ELSE N := NIL; 
END "CASE"; 
UNTIL H = NIL; 
2: INSYN80L; 

END «»NOT PROCEDURE"; 
" 3: REP := NO IN SET ( 1,41,43 ,44,45) ; •• 

3: REP := (NO==l ) nN0=4U MN0=43I M N0=44l MN0=45 » ; 

IF NO = 16 THEN 

BEGIN INSYMSOL; REP := NO -.= 10 END; 
IL -REP; 
NO -.= 10 THEN 
IN ERR0RI9I; SKIP(IO) ; 

IF NO IN SET{41,43,44,45) THEN GOTO 1;" 
IF {N0 = 41) I (NQ=4.3) MN0=44H<N0=45j THEN GOTO 1 



ELSE 

:= Ni. NXTEL END 



UNT 

IF 

BEG 
« 

END 
mrE 
N : 
WHI 
BEG 

END: 



vErS^ POINTERS" 

= NE^^» NEX^ :~ NiL; 

LE N -= NIL DO 

IN P := N; N := P3.NXTEL; 

Pa -NXTEL := NEXT; NEXT := 



p; 
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END "FOR MP ARM"; 

PROCEDURE ENTERBnOY; 

VAR I: INTEGER; TATTR:ATTR; ACONtCONSTANT ; 
ATEMP:ALFA; CTEMP: ARRAY( 1. . 10) OF CHAR; 
BEGIf^ ISTKLIM:=MAXISTK; ASTK( MAXI STK » :=0 ; RP:=0; 

tct:=lc; tmax:=lc; 

IG:=0; ClABIx:=0; 

FLCX:=0; HLCX:=o; ALCX:=0; RLCX:=0; ELCX:=0; CHNIX;=1; 

"PR3CEDURE EMTRY CODE" 

GENRX{#47»l5»20f0»15); "B AROuNQ ENtRY I 0« 

C00E{ IC):=10; "LENGTH OF ENTRY POINT IDENTIFIER" IC:=IC+l; 

IF SUrrptR=NIL THEN ATEMP :=• $$$mAI N« 

ELSE ATEMP:=SURRPTRa.NAMe; 

UMPACKIATEMPfCTEMP,!); 

FOR I: = l TO 10 DO CODE ( IC + I-U :=I NTICTEMPC 1 1 ) ; 

IC:=IC+10; 

CODEC IC):=0; IG: = IC-H; "REALIGN TO FULL-WORD" 

IC:=IC+4; "LOCATION 16(15) WILL HOLD LENGTH OF DATA AREA" 

GENRS( #90, 14, 12, 12 , 13) ; "STM" 

GENJRR{#18t3,15); "LR" 

GeNRX(#41,4,4095,0,3); "LA" 

Ge*<RX(#41,4,l,0,4) ; "LA« 

GEMRX(#50,13,4,0t2); "ST" 

6eMRX{#50,2,8tOf 13); "ST" 

GeNRR(#l8,13t2) ; "LR" 

GENRX<#5A,2,16,0,3) ; "A" 

GENRX{#59,2,SO,0,12); "C 2,GETMAIN LIMIT« 

GENRXC#47, 12, 0,0,0); "BNH" 

I := IC-2; 

GENRR{#lB,l,ll; "SR" 

WITH ACON 00 

BEGIN KONSTKIND := EXTREF; EVALUE := ♦PSCLERR'; 

L0CST2{AC0N,15) ; »=V(PSCLERR) " 
EMD; 



15) 



"BR" 



THEN 



INTO STACK 
«L GETHAIN 



FROM AOR^MLC 
LIMIT" 



"LA 
"LA 



- DESTINATION" 

- SOURCE" 



GEMRR{#07,15, 
IMSdCI); 
IF {L6VEL=0)SVDATA 
WITH ACON DO 
BEGIN "MOVE VALUE INITS 
GENRX<#58,8,80,0»12); 

K0NSTKIND:=EXTREF; EVALUE := « $GbLDAT • ; 
L0CST2(AC0N,)-l); "=V{$G8LDAT}m 
KONSTkiND: = INTEGERS; I VaL^E :=I^LC ; 
LDCST2{AC3N,9); 
GeNRXC#41, 10,0, 12,9) 
GEMRX(f4l,llfO»ll»9) 
IF VLC-ML0256 THEN 
BEGIN 

GENRX(#41,6,25&,0,0); 

IVALUE:=VLC-256; 

LDCST2(AC0N,7) ; "=A { VLC-256) " 

GENRX<#41,7,0,12,7); "LA - LIMIT" 

I s = I C * 

GgNSs!#D2, 0,255, 10,0,11) ; "MVC" 

GENRR*iPlA,ll,6); "AR" 

GeNRSC#87, 10,6,0,0); "BXLE" 

IMS < I, IC-2); 
EMD; 
GENSSt#D2,0,CVLC-MLC-l) MOD 256,10,0,11) 



m 
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TO VLC" 



•LA" 
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40B2. 
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4084, 
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4096. 
4097. 
4098. 
4099. 
4100. 
4101. 
4102. 
4103. 
4104. 
4105. 
4106. 
4107. 
4108. 
4109. 
4110, 
4111. 
4112. 
4113. 
4114. 
4115. 
4116. 
4117. 
4118. 
4119. 
4120. 
4121. 
4122. 
4123, 
4124. 
4125. 
4126. 
4127. 
4128. 
4129. 
4130. 
4131. 
4132. 
4133. 
4134. 
4135, 
4136. 
4137. 
4138. 
4139. 
4140. 
4141, 



GENRX{#50,8t80,0»12J ; "ST GETMAIN LIMIT" 
FMO; 

WITH TATTR DO 
BEGIN 

ALIGNMENT:=4; KINO:=VARBL; TYPTR :=I NTPTR? 8REG:=LEV6L 

ACCESS:=DRCT; PCKD:=FALSE; 
EMD; 

"FILE I^JITIALIZATION CODE" 
FOR I:=FILEVCLEVEL) TO FILTOP 00 
WITH ACON,FILPTSn)a DO 
BEGIN 

TATTR. 0PLMT:=VA0DR; 

6ENA00R (TATTR, on 

WITH RXADOR DO GENRX( #41 » I tD2 » X2 t B2 ) ; 

GeNRX{#4l,0tl6,0,l}; "LOAD ADR OF BUFFER" 

GENRX(#50»0t0,0t 1); "STORE BUFFER PTR IN FCB" 

K0NSTKIMD:=ALFAS; AVaLUe :=NAME ; 

GENSS{#D2,4»9, 1,0,0); "MCV - FILENAME INTO FCB" 

GENC0NST(ACQN,IC-2); 

K3NST<IND: = INTEGERS; IVALUE :=VTyPE3.FELTYPES).SI ZE; 

L0CST2(AC3N,0) ; 

GENRX{#40, 0,14, 0,1); "STH - RECORD SIZE INTO FCB" 

end; 

"CLASS INITIALIZATION CODE" 
FOR I:=PILEV{LEVEL) TO PFTOP 00 
WITH TATTR, RXADOR 00 
BEGIN 

DPLMT:=PFL(I); "ADDRESS OF CLASS" 

GENADDRITATTR,0); 

GENRXCi41,l,D2,X2,B2); 

GENRX(#41,0,8,0,1); "FREE POINTER" 

GENRXt#50,0,0,Otl); "STORE IN CtAsS DESCRiPto'^" 

DPLMT: = PEnOU J; 

GENADORC TATTR, 01; 

GENRX(#4l,0,D2,X2,B2l ; 

GENRX{#50,0,4,0,1); "STORE IN CLASS DESCRIPTOR" 
END; 
END "ENTERBODY"; 

PROCEDURE LEAVE80DY; 
TYPE LTYP={R,F,E,H,A,MI; 



VAR U^4SPEC: 
R: (ROUMMY 

F: IFDUNMY 
E: JEDUS^^MY 
HrCHDUHMY 
AJ<ADUMHy:REAL 

W:CWDUMNY:REal 



RECORD CASE CTYPrLTYP OF 
REAL; RVAL:REALJ; 

FVAL: INTEGER); 

EVAL: INTEGER); 

HVAL:SHRTINT) ; 

AVAL: ALFA); 

ATEMPiARRAYtl. 



IREAL: 

tREAL 

:REAL; 



10) OF CHAR) 



END; 
"KLUOGED To OVERLAY RVaL» FVAL, ETC." 

LELCX, IT2,IT3»SaVEIC»SAVEIC2,TCHAIN,TINX: 

namejalfa; 



INTEGER 



PROCEDURE FIXCONSTCLENGMNTEGER; FINX rSHRTiNT) ; 
VAR It IT2»8YTE1,8YTE2,INDEX:INTEGER; 
BEGIN INDEX:=FINX; 

IF ie+LENG<C00MAX THEN 
BEGIN 

FOR IT2:=l TO LENG 00 CODE {IG+IT2-1 ) :=INTi UNSPEC. ATEMP( IT2) ) ; 
8YTEl:=BASEREG{IC DIV 4096 •H)*16+IC MOD 4096 01 V 256; 



n^imRfW'.fmnKfl 



4142. BYTE2:=IC NHO 256; 

4143. WHILE lNDEX-.= DO 

4144. BEGIN 

4145. IT2:=C0DE( I NOEX) *256+C0DE ( I NDEX+1) ; 

4146. CQDE(INDEX):=BYTEl; 

4147. CQDE(!N0EX+U: = BYTE2-; 

4148. IN0EX:=!T2 

4149. emd; 

4150. !F PCODE THEN 

4151. BEGIN 

4152. OUTCHC •); OUTCHC • •); OUTHEX( IC, 6) ; OUTCHf • M; 

4153. OUTCHi* •); OUTCHC »DM; OUTCHCCM; OUTCHl » »); 

4154. OUTCHC 'X* I; OUTCH{»«««); 

4155. F3R I: = l TO LENG DO OUTHEXtCODEMC + I-1 ) .2 ) ; 

4156. OUTCHC '••I; OUTCH(EOL); 

4157. EMD; 

4158. IC:=IC+LENG; 

4159. END ELSE ERRORCIO?) 

4160. END "FIXCONST"; 
4161. 

4162. BEGIN 

4163. "MARK UNOEFINED LABELS AS ERRORS" 

4164. FOR IT:=l TQ CLA8IX 00 

4165. WITH LABTABdT) DO 

4166. IF LABLOC=0 THEN "UNDECLARED LABEL" 

4167. BEGIN 

4168. ERRMESSAGEC »LA9EL: SLARVAL) ; 

4169. TCHAIN:=CHAIN; 

4170. WHILE TCHAIN-»=0 DO 

4171. BEGIN 

4172. ITl:=C00E(TCHAINi*256+C0DEf TCHAIN+1) ; 

4173. INSUCTCHAIN); 

4174. TCHAIN:=IT1 

4175. END; 

4176. CHAIN:=TCHAIN 

4177. END; 

4178. "CODE TO CALL CLOSE ROUTINES FOR FILES GOES HERE" 

4179. "EXIT CODE FOR PROCEDURES" 

4180. GENRX(#5a,13,4,0,l3j ; "L - DYNAMIC BACK LINK" 

4181. GENRS(i98,l4, 12, 12,13) ; "LM - RESTORE REGISTERS" 

4182. GENSl(i92, 12, 13,2551 ; "MVf - RgruRN FtAG" 

4183. GeNIRR(f07,15,14); "BR 14" 

4184. UPALI6N<TMAX,8); 

4185. C0DE(16):=T^AX OIV 16777216; 

4186. C3DE( 17): = T?4AX DiV 65536 MOD 256; 

4187. Ca0E(18):=TMAX DIV 256 MOD 256; 

4188. CODEC 19) :=TMAX MOD 256; 

4189. SAVEIC:=IC; 
4190. 

4191. "RESOLVE CONSTANTS, INSERT IN CODE" 

4192. IF PCODE THEN 

4193. BEGIN OUTCHC EOL); OUTALFC »CONSTANTS« , 101 ; OUTCHC EOLI END; 

4194. UPALIGNC IC,3); 

4195. FOR IT2 := SAVEIC TO IC-1 DO C0DECIT2) '.= 0; 

4196. WHILE RLCX-.= DO 

4197. WiTH CSTTBCRLCX) DO 

4198. BEGIN 

4199. UNSPEC.RVAL:=VALU. RVALUE ; 

4200. FIXC0NSTI8,lNX); 

4201. RLCX:=CNEXT 



• 



m 
m 









• 



m 
m 



4202. 
4203, 
4204. 
4205. 
'♦206. 
4207. 
4208. 
4209. 
4210. 
4211. 
4212. 
4213. 
4214. 
4215. 
4216. 
4217. 
4218. 
4219. 
4220. 
4221. 
4222. 
4223. 
4224. 
4225. 
4226. 
4227. 
4228. 
4229. 
4230. 
4231. 
4232. 
4233. 
4234. 
4235. 
4236. 
4237. 
4238. 
4239. 
4240. 
4241. 
4242. 
4243. 
4244. 
424 5. 

4246. 
4247. 
4248. 
4249. 
4250. 
4251. 
4252. 
4253. 
4254. 
4255. 
4256. 
4257. 
4258. 
4259. 
4260. 
4261. 



end; 

WHILE FLCX-.= 00 
WITH CSTTB(FLCX) DO 
BEGIN 

U^l SP EC. FVAL:=VAL U.I VALUE; 

FIXC0^IST(4,INX); 

^LCXt^CNEXT 
EMD; 

LELCX:=ELCX; UNSpEC .EVAL:=0; 
WHILE LELCX-,= 00 
WITH CSTTStLELCX) DO 
BEGIN 

TINX:=IC; 

FIXC0NSTl4,IMXn 

IMX:=TIMX; 

LELCX:=CNEXT 
ENO; 

WHILE HLCX-.=0 00 
WITH CSTTB(HLCX) DO 
BEGIN 

unspec.hval:=valu.ivalue ; 
fixc0nst(2,inx); 

HLCX:=CNeXT 

END; 

While alcx-.=o do 

WiTH CSTTBCALCX) 00 
BEGIN 

UN SPEC. AVAL :=VALU. A VALUE; 

FIXCOMSTdOfiNx); 

ALCX:=CNEXT 
end; 

IF SURRPTR-.=NIL Then NAME: = SURRPTRa.SDNAME 
ELSE NA^1Ei = »$$$MAIN'; 
FSTIXG:=FSTIX; 
WRITOUT(NAME); 

SAVEIG2:=IC; IG:=SAVEIC; IF PCOOE THEN PRTCOMP; 
IC:=SAVEIG2; 
CEXTA8IX:=FSTIX-l; 
END "LEAVEBODY"; 

BEGIN "BODY" 
DPi=TRUE; 

IC:=0; MLC:=16T77216; Vlc:*0; 
PILEV{LEVEL}j= pfTop+i; 
IF LEVEL=0 THEN 
BEGIm FlLeV(0):=0; LC :=72+8+4+20+20 END 

Else fIlevilevelm=filtop+i; 

FSTIX := CEXTABlX + 1 ; 
IF NO = 40 THEN ''LABEL" 
BEGIN REPEAT INSYH80L ; 

IF {NO = 2)6(CL « 1) THEN 
BEGIN FOR IT := FSTIX TO CEXTABlX 
IF EXTASdTJ.EXVAL = IVAL THEN 
BEGIN ERROR (77) ; GOTO 2 END ; 
IF CEXTABlX = MAXEXLA6S THEN 
BEGIN CEXTABlX := CEXTABlX + 

setsoname; 

WITH EXTA8(CEXTABIX| 00 

BEGIN 

EXTNAMe:=UNl QUE NAME; 



m 
m 



m 



m 
m 



DO 



ERRGR(78) ELSE 

I ; 






—r iiiMi iwr iiiiM iMiii 






• 



m 
m 



4262. 
4263. 
4264. 
4265. 
4266. 
4267. 
4268. 
4269. 
42 70. 
4271. 
4272. 
4273. 
4274, 

4275. 
4276. 
4277. 
4278. 
4279, 
4280. 
4281. 
4282. 
42 83. 
4284. 
4285. 
4286. 
4287. 
4238. 
4289. 
4290. 
4291. 
4292. 
4293. 
4294. 

429 5. 
42^6. 
4297. 
4298. 
4299. 
4300. 
4301. 
4302. 
4303. 
4304. 
4305. 

430 6. 
4307. 
4308. 
4309. 
4310. 
4311. 
4312. 
4313. 
4314. 
4315, 
4316. 
4317. 
4318, 
4319, 
4320. 
4321. 



2: 



3: 



UN 

FI 

END ; 

IF NO 

8EGIN 



EXLEVet:=LEVEL; 
EXVAL:=IVAL 
END; 
END ; 
INSYMROL 
END "IF (N0=2J&(CL=1)» ELSE 
BEGIN ERR0R{61) ; GQTQ 3 ENO 
TIL NO -.= 15 "♦" ; 

ndsemicolon; 



m 

m 



= 41 THEN 
INSYHBOL 
WHILE NO 

BEGIN REP 
ALLOC! 
WITH P 
BEGIN 

CONk 
END; 
INSYMB 

IF tm 

WITH P 
IF NQ 
BEGIN 

VAL 

END EL 

WITH V 

BEGIN 

CON 

CAS 

INTEGERS, 

rEAlS: R 

ALFAS: A 

ENO 

INS 

END; 

WHI 

BEG 



END •• 
IF NO 

BEGIN 
WHILE 
BEGIN 

TY 

IF 
ER 
IF 
IF 
BE 



END 
UNTIL 
FINDSE 
END " WHI 
CDNST"; 
=37 THEN 

insymbol; 

MO = 1 DO 

SRCHRECCn 

PID := AVA 

(NO -^= 8) 
R := FALSE 

-.ERR THEN 
Pa-NAME -1 

GIN PS.NAM 
NEXT := P; 

o; 
ndsemicolon; 



" CONST " 

= I DO 

EAT SRCHRECCNEXTi ; IF CTPTR -= NIL THEN ERRORfS}; 

PtKONSTtACTUAL) ; 

a DO 

NAME := Aval; NXTEL := NEXT; KLASS := KONST; 

iNo := actual; 

NEXT := P; 

ol; 

-.= 8) I (CL -= 6J THEN ERR0R14I ELSE INSYMBOL; 

a DO 

= 36 THEN •♦ NIL " 
CflNTYPE := NILPTR; 

UES := nilval; insyhbol; 

SE 

ALUES DO 

INCONST(KKIND,N,N£XTa.NXTEL} ; 
TYPE := N; KONSTKIND := KKIND; 
E KKIND OF 

CHARSf SYMBOLICS: IVALU5 := IVAl; 
VALUE := RVAL; 
VALUE := aval; 

"CASE KKIND"; 
yHbOl; 

LE NO = 15 00 

IN INSYMBOL; 

IF NO -.= I THEN 

BEGIN ERRORlll); SKIPdSJ END; 

• 

NO -.= i; 

micolon; 

LE NO = 1 '» ; 
"TYPE" 



Ext I; IE CTPTR -.= NIL THEN ERROR (8 »; 

l; Insymbol; 

j {Cl •-.= 6) THEN ERR0R(4j ELSE INSYMBOL; 
; TYpEOECLtTLfP) ; 

BLANK THEN ERR0R<96i ELSE 
E := TYPID; PS.NXTEL := NEXT; 



EN 

Fl 
END; 
END "TYPE" 



m 
• 



m 



m 

m 



4322. 
4323. 
4324, 
4325. 
4326. 
4327. 
4328. 
4329. 
4330. 
4331. 
4332. 
4333. 
4334. 
4335. 
4336. 
4337. 
4338. 
4339. 
4340. 
4341. 
4342. 
4343. 
4344. 
4345. 
4346. 
4347. 
4348. 
4349. 
4350. 
4351. 
4352. 
4353. 
4354, 
435 5. 
4356. 
4357. 
4358- 
4359. 
4360. 
4361. 
4362. 
4363. 
4364. 
4365. 
4366. 
4367. 
4368. 
4369. 
4370. 
437 1 . 
4372. 
4373. 
4374. 
4375. 
4376. 
4377. 
4378, 
4379. 
4380. 
4381. 



IF 


NO 


IF 


PT 


8EGIM 




FO 




86 




EM 




IF 




FQ 


ENO; 


DP 


: = 


IF 


NO 


IF 


(M 


BEGIN 




RE 



!= OLOLEV; GOTO 1 END; 



PROCEDURE •• 



KLASS : 
ACTUAL; 

:= SURRPTR; 



END; 



PROC; 



= 43 THEN "VAR« VAROECL*, 
X > THEN 

ERR0Rtl2J; OUTCHiEOLJ; 
R PTX := PTX-l DOWNTO DO 
GIN FOR I := 1 To g 00 OUtALFIBLANK, lO) ; 

OUTALFi •CLASS-IDS lO); 

outalf(ptlist(ptx),hname»io) ; outch(eol) ? 
0; 
-.eolflag then 

R I := 1 to CHCNT+8 DO OUTCH* • •); 

FALSE; 

IN SET* 44,45) THEN«»'FUNCTI ON OR PROCEDURE" 
0=44)MN0 = 45) THEN "FUNCTION OR PROCEDURE" 

PEAT 
LL := NO; ERR := FALSE; 
OLDLEV := LEVEL; 
IF LEVEL < MAXLEVEL THEN LEVEL := LEVEL *- I ELSE ERR0RC76) 

i^^symBol; 

if no -.= i then 

BEGIN ERRORdll ; LEVEL 
LCI := LC; SRCHREC(NEXT); 
IF CTPTR ^= NIL THEN 
IF CTPTRS. KLASS -.= PROC THEN 
BEGIN ERROR {3}; CTPTR := NIL END; 
IF CTPTR = NIL THEN " UNDECLARED 
BEGIN ALLOC ( PROC PTR, PROC J ; 
WITH PRDCPTR3 DO 

BEGIN NAME := AVAL; NXTEL := NEXT; 
PROCTYPE := PROCPTR; PROCKIND := 
PROCLEVEL := LEVEL - I; SURRPROC 
PREDEF:=FALSE; 
IF PROCLEVEL=D THEN 

BEGIN GL0BALNAME:=AVAL; uMiQINDEXi^O 
SETSDNAME; 
SONAMEt^'JNIQUENAME; 
EmD; 

DISPLAY(T0P),FNAME := PROCPTR; 

NEXT := NIL ; 

insymbol; 

IF LL = 44 THEN « FUNCTION " 

BEGIN IF NO -.= 9 THEN ERR0R(29) ELSE 

begin lc := 76; "save space for ptr to rtn valcat 72)" 
insymbol; formparm end; 

IF ERR THEN PROCPTRa. PROCTYPE := NIL; 
IF NO = 10 THEN 
BEGIN INSYMBOL; 

IF NO -.= 19 THEN ERRORflO) ELSE INSYMBOL; 
IF NO n= I THEN 
BEGIN ERRORtll); SKIPC49); 
PROCPTRa. PROCTYPE := NIL; 
END ELSE 
BEGIN search; 
If CTPTR ^= NIL THEN 
BEGIN IF CTpTRa-KLASS -.= TyPES THEN 

BEGIN ERR0RI93); CTPTR := NIL END ELSE 
IF CTPTRa.FnRM > POWER THEN 
BEGIN ERR0R193) ; CTpTR := NIL END ; 
End ELSE ERR0R(l2) ; 



4332. 
4383. 

4384. 
4385. 
4386, 
4387. 
4388. 
4389- 
43'='0. 
4391. 
4392. 
4393. 
4394. 
4395. 

439 6. 
4397. 
4398. 
4399. 
4400. 
4401. 
4402. 
4403. 
4404. 

440 5. 
4406. 
4407, 
4^08. 
4409. 
4410. 
4411. 
4412. 
4413. 
4414. 
4415. 
4416. 
\h 17 . 
4418. 
4419. 
4420. 
4421. 
4422. 
442 3, 
4424, 
4425. 
4426. 
4427. 

442 8. 
4429. 
4430. 

443 i . 
4432, 
4433. 
4434, 
4435. 
4436, 
4437. 
443 8, 
4439. 
4440, 
4441. 



ELSE " PROCEDURE " 



procptra.proctype := ctptr 

insymbol; 
ENJO; 

END "NO = 10"; 
EMD " FUNCTION •♦ 
BEGIN LC := 72 ; 

IF NO = 9 Then '• parmlist " 

BEGIN INsyMBOL; pORMPAR^^; 

IF ERR THEN PROCpTRa. PROCTYPE := NIL; 
IF NO = 10 THEN INSYMBOL; 

END "NO = 9"; 
END "PROCEDURE"; 
IF NO -%= 16 THEN 
BEGIN PROCPTRa.PROCTYPE := NIL; 

ERRnR{58); SKIP(16); 
END ELSE INSYMBOL; 
PROCPTRa.FORMALS := NEXT; 
IF (NO^ll £ (AVAL=»FORWARDM THEN 
BEGIN NEXT := PROCPTR; 

PROCPTRa.SEGSIZE := -LC; 
» SEGSIZE < SIGNIFIES FORWARD-DECLARATION 

INSYMBOL; 



m 
m 
m 



oCCuR := BLOCK END; 



END ELSE 

BEGIN TOP := lEvEL ♦ I; 

wIth dIsplay(Topi do 

BEGIN FNAMe := N^XT; 

ALLOC < LF I R stents. YtOUMMYC lass} 

bodycprocptr,lfirstentry) ; 

END; 
END " NEW PROC •• ELSE " PROC ID ALREADY 
BEGINl 

IF CTPTR3. SEGSIZE >= THEN " PREV. DECL 

ERROR C 16) ; 
INSYMBOL; 

IF NO = 9 THEN " IGNORE PARM-LIST " 
BEGIN ERR0RI23); 
" REPEAT SKIPIIOI UNTIL ^4 NO IN 
REPEAT INSYMBOL; SKIPCIOI UNTIL 

-.(CN0=16} jiN0=4i> MN0=43) |(N0=44} I (N0=45H 
NO -.= 10 THEN ERR0R(9> ELSE INSYMBOL; 



DECLARED " 



NOT FORWARD » 



m 



SET (16, 41, 43 f 44,45));" 



IF 

END; 

IF NO 
IF NO 
IF 



= 15 THEN SKIP(16); 

-.= 16 THEN ERR0R(58) ELSE INSYmbOL; 

( AyA^st Forward* > then "again for^^ard" 
Else 



insymBol 

BEGIN 
PROCPTR := CTPTR; 
WITH PROCPTRa DO 
BEGIN LC := -SEGSIZE; 
IF PR0CLEVEL=0 THEN 
BEGIN GL08ALNAME:=NAME; 

uniq!ndex: = 0; 
setsoname; 

END 

end; 

TOP := LEVEL + 1; 
WITH DISPLAYCTOP) 00 

BEGIN FNAME := NEXT; OCCUR 
ALLOC I LF IRSTENTRY, DUMMYCLASS ) 

800Y(PR0CPTR,LFIRSTENTRY) ; 



NEXT := FORMALS; 



• 



:= BLOCK END; 






• 

m 



m 

m 



m 
m 
m 



m 
m 



4442. 
444-3. 
4444. 
4445. 
4446. 

444 7. 
4448. 
4449. 
4450. 
4451. 

445 2. 
4453. 
4454. 
4455. 
4456. 
4457. 
4458. 
4459. 
4460. 
4461. 
4462. 
4463. 
4464. 
4465 . 
4466. 
4467. 
4468. 
4469. 
4470. 
4471. 
4472. 
4473. 
4474. 
4475. 
4476. 
4477. 
4478. 
4479. 
4480. 
4481. 
4482. 
4483. 
4484. 
4485. 
4486. 
4487. 
4488. 
4489. 
4490. 
4491. 

4492. 
4493. 
4494. 
4495. 
4496. 
4497. 
4498, 
4499. 
4500. 
4501. 



EMD "NOT FORWARD"; 
e-^JD •♦ OLD PROCEDURE " ; 
LC := LCl; 
LEVEL := OLOLfiV; 
FI^JDSEMIC0LON; 
'•UNTIL Mm IN SET( 44,45)) ; " 
UNTIL -.{(NG = 44) I (N0=45) ) ; 
END » FUNCTION OR PROCEDURE " ; 
DISPLAY(TOP).FNAME := NEXT; 
IF Na^=l7 THEN 
BECjIN 

IF N0-.= 2l THEN 
BEGIN ERR0R(24); SKIP{49); 
" WHILE NO IN SET{ 16,22) DO '• 
WHILE (NO=16)MNO = 22) 00 
BEGIN INSYMBOL; 

SKIP(49) ; 
END ; 
"IF NO IN SET{37,40,41,43,44,45) THEN GOTO 1; »» 
IF {N0 = 37) I JN0=40) MN0=41) |(N0=43) |(N0=44) | 1N0-45J 
THEN GOTO 1; 
END ELSE 

enterbqdy; 
compstat ; 
leavsbooy ; 

END; 

IF SURRPTR -.= NIL THEN SURRPTRa. SEGSI ZE := LC ; 
ALLOC (P,DUMMYCL ASS ) ; 
RESETtFlRSTENTRY) ; 

TOP := LEVEL; NEXT := DI SPLAY(TOP> .FNAHE ; 
END " BODY " ; 



BEGIN 



M *** MAIN PROGRAM *** •» 



# 

41 



ONE:=l; TEN:=10; TENTH;=0NE/TEN; "NO REAL CONSTANTS IN COMPILER" 
" BUT FIXEDTOELOAT HAS TO WORK " 

ALLOC! NILPTR, TYPES, POINTER); 

WITH NILPTR3 DO 

BEGIN NAME := BLANK; NXTEL := NIL; ALIGN := 4; 

KLASS := TYPES; SIZE := 0; FORM := POINTER; DOMAIN 

ELTYPE := NIL; 
END: 
NILVAL.KONSTKIND := INTEGERS; NI LVAL. I VALUE := 0; 



:= NIL; 



"TEXT 



NEXT := NIL; 

FOR IT := TO 11 00 

BEGIN alloCcpt,proc); 

WITH PTi DO 

BEGIN NAME := iNlTNAMJiT-l) 

KLAsS := PROC; PROCTYPE 

SURRPROC := NIL 

proclevel := 0; 

End; 

NEXT := PT; 

end; 



HRITE" 



NxtEL := NEXT; ^lIGm := 4; 
= PT; FORMALS := NIL; 
PROCKIND := ACTUAL; SEGSI Z£ := IT; 
PREDEF := TrUe; 



FOR IT :■= 1 TO 9 DO 
BEGIN ALLOCCPT,PROCI 
WITH PT3 00 



"ODD 



SUCC" 



• 



4502. 8EGIM NAME i= IM I TNAM( I T+IO) ; NXTEL ;= NEXT; ALIGN := 4; 

4503. KLASS := PROC", PROCTYpf: := niLPtR; FORMALs := NIL; 

4504. SURRPROC := NIL; PROCKINO ;= ACTUAL; SEGSIZE := IT; 

4505. PROCLEVEL := 0; PREDEF := TRUE; 

4506. END; 

4507. NEXT := PT; 

4508. END; 
4509. 

4510. ALLOCJCTPTR, TYPES, FILES) ; 

4511. WITH CTPTR3 DO 

4512. BEGIN NAME := BLANK; NXTEL := NIL; ALIGN := 4; 

4513. KLASS := TYPES; SIZE := 17; FORM := FILES; 

4514. END; 
4515. 

4516. "WAS THE ABOVE NECESSARY? CHECK IT OUT" 
4517. 

4518. XFILPT := CTPTR; 

4519. FOR IT := 22 TO 23 00 

4520. BEGIN ALLOCCPT, VARS ) ; "INPUT» OUTPUT" 
•^521. WiTh Pia DO 

4522. BEGIN NAME := iNlTNAM(IT); NXTEL := NEXT; ALIGN := 4; 

4523. KLASS := VARS; VTYPE := CTPTR; VKINO := ACTUAL; 

4524. If it = 22 THEN VADDR := INPT ELSE VAODR := OUT PT ; 

4525. VLEVEL := 0; FRPTSt IT-22) := PT; NEXT := PT ; 

4526. SSIZE := VTYPES.SIZE; 

4527. END; 

4528. END; 
4529. 

4530. ALLOC(ALFAPTR, TYPES, SYMBOLIC); "ALFA" 

4531. WITH ALFAPTRi DO 

4532. BEGIN NAME 5= INITNAM(24); NXTEL := NEXT; ALIGN := 1; 

4533. KLASS := TYPES; SIZE := 10; FORM := SYMBOLIC; 

4534. FCONST := NIL; PWSET := NIL; BIT5IZE := 80; 

4535. END; 
4536. 

4537. ALLOC(REALPTR»TYPES, SYMBOLIC); "REAL" 

4538. WITH REALPTRi 00 

4539. BEGIN NAME := lNiTNAMl25); NXTEl := AL<=APTR; ALIGN := B; 

4540. KLASS := TYPES; SIZE := 8; FORM := SYMBOLIC; FCONST := Nil; 

4541. PWSET := nil; BITSIZE := 64; 

4542. END; 
4543. 

4544. ALL0C(CHARPTR,TYPES, SYMBOLIC); "CHAR" 

4545. WITH CHARPTR3 DO 

4546. BEGIN NAME := INITNAM(2&); NXTEL := REALPTR; ALIGN := l; 

4547. KLASS := TYPES; SIZE := 1; FORM := SYMBOLIC; BITSIZE := 8; 

4548. PWSET :* NIL; "PWSET OF CHARS NOT PRESENTLY ALLOWED " 

4549. END; 
4550. 

4551, XFILPTa.FELTYPE := CHARPTR; 
4552. 

4553. ALLaC(PT,KONST, ACTUAL); 

4554. WITH PTa DO 

4555. BEGIN NAME i= BLANK; NXTEL := NIL; ALIGN i= 1; 

4556. KLASS := KONST ; CONTYPE := CHARpTR; cONKiND := ACTUAL; 

4557. SUCC := NIL; VaLUeS.KONSTkiNO := INTEGERS; yALyES. I VAluE := 256; 

4558. END; 
■4559. ■ , 

4560, CHARPTRa. FCONST := PT; 
4561. 



m 



# 
• 



• 

• 



m 

m 



4562. 
4563. 
4564. 
4565. 
4566. 
4567. 
456B. 
456Q. 
4570. 
4571. 
4572. 
4573. 
4574. 
4575. 
4576. 
4577. 
4578. 
4579. 
4580. 
4581. 
4582. 
4583. 
4584. 
4585. 
4586. 
4587. 
4588. 
4589. 
4590. 
4591. 
4592. 
4593. 
4594. 
4595. 
4596. 
4597. 
4598. 
4599. 
4600, 
4601. 
4602. 
4603. 
4604. 

46^3. 
4606. 
4607. 

4608. 
4609. 
4610. 
4611. 
4612. 
4613- 
4614, 
4615. 
4616. 
4617. 
4618. 
4619. 
4620. 
4621. 



ALLOCCBOOLPTR, TYPES, SYMBOLIC) ; "BOOLEAN" 

WITH BOOLPTRa 00 

BEGIN NAME := INITMAM{27|; NXTEL := CHARPTR; ALIGN := 2; 

KLASS := TYPES; SIZE := 2; FORH := SYMBOLIC; BITSIZE :=1; 

END; 

alloccptfkonst, actual) ; "eol" 

wIth pts do 

BEGIN NAME := lNlTNAf-l(20); NXTEl := BOOLPTR; ALIGN := I; 
KLASS := KONST; CONTYPE := CHARPTr ; SUCC := NIL; 

conkInd s= actual; 

VALUES. K0NSTKI!^D := CHARS; VaLUeS, I VALUE := 0; 

END; 

NEXT := PT; 
CTPTR := NIL; 
FOR IT := TO 1 DO 

BEGIN ALLOCCPT,KONST, ACTUAL); "FALSE, TRUE" 
HITH PTa DO 

BEGIN NAME := IN ITNAM( I T+28) ; NXTEL := NEXT; ALIGN i= 2; 
KLASS := KQNST; CONTYPE := BOOLPTR; CONKIND := ACTUAL; 
SUCC := CTPTR; VALUES. KONSTKI NO := INTEGERS; 
VALUES. IVALUE := IT; NEXT := PT; 
END; 
END; 

B00LPTR3.FC0NST := NEXT; 

ALLOC(INTPTR,TypESf NUMERIC); "INTEGER" 
WITH INTPTRa DO 
BEGIN NAME := INITNAM(30); NXTEL := NEXT; ALIGN := 4; 

KLASS := TYPES; SIZE := 4; FORM := NUMERIC; BITS := 32; 
MAX := 2147483647; MIN := -MAX - 1; 
END; 



ALLOCCPT, TYPES, POWER); ' 
WITH PTa DO 

begin name := blank; nxtel := nil; align := 4; 
klass := types; size := 4; form := power; 
elset := boolptr; pwblts := 3; 

End; 

BOOLPTRa.PwsET := ^T; 
ALLOC(UNDECPTR,VARS) ; 

WITH undecptRs Do 

BEGIN NAME := BLANK; NXTEL := NIL; ALIGN := 4; 
KLASS := VARS; VTYPE := NIL; VKIND i= ACTUAL; 
VADDR := 0; VLEVEL := 0; SSl ZE := 4; 

END; 

ALLOCCPNUMPTR, TYPES, POWER); 

WITH PNUMPTRa DO 

BEGIN NAME := BLANK; NXTEL := NIL; ALIGN := 4; 

KLASS := TYPES; SIZE := 4; FORM t= POWER; 

ELSET := INTPTR; PWBITS := 32; 
END; 

ALLOCClAhpTR, TYPES, POWER) ; 
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4622. 




4623. 


4624, 




4625. 




4626. 


4627. 




4628. 




4629. 


4630. 




4631. 




4632, 


4633, 




4634. 




4635. 


4636. 




4637. 




4638, 


4639. 




4640. 




4641, 


4642. 




4643. 




4644. 


4645. 




4646. 




4647. 


4648. 




4649. 




4650. 


4651. 




465 2. 




4653, 


4654. 




4655. 




4656. 


4657. 




465 8. 




4659. 


4660. 




4661. 




4662. 


4663. 




4664. 




4665. 
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WITH LAMPTRa 00 

8EGIN NAME := BLANK; NXTEL := NIL; ALIGN := 4; 

KLASS := TYPES; SIZE := 1; FORM := POWER; 

ELSET := nil; PW8IT5 := 0; 
END; 

EXTPTR := INTPTR; 
"XFILPT := FILPTSCS); 
WITH XFILPTa DD 
BEGIN AELTYPE := INTPTR; 

INXTYPE := INTPTR; 
EnO; who knows WHAT IS GOING ON HERE???" 

« INITIALISATIONS " 

6RRINX := 0; POSl := 0; EOLFLAG := TRUE; SYSPRINTa := 8LANKLINE; 

PTOUT := O; DP := TRUE; ERR := FALSE; 

PRCOOe := FALSE; ASSCHECK := FALSE; INXCHECK i= FALSE; 

OIVCHECK := FALSE; STOFLCHECK := FALSE; TRACECHECK := FALSE; 

PCOOE := FALSE; VDATA := FALSE; LISTING := TRUE; 

PFTOP := -l; FILTOP := I; CEXTABIX := 0; 

PTX := O; CHNIX := 1; a60PL := 72; 

le := O; BASEREGNO := I; BASE := BASEREGCBASEREGNOr; 

DI$PLAyiOr.FNA!«IE := EXTPTR; DI SPLAVi OJ, OCCUR := SLOCK; 

NO := 0; LC := IG; 
nextch; insymbol; 
while {no -.= 17 ".»• j do 

BE^In DlSPLAY(l)iFNAMe := NIL; 
0ISPLAY( D-OCCUr := BLOCK; 
TOP := i; LEVEL := 0; N^XT := NIL; 
GLOBALNAME := '$$$MAIN«; UNIQINDEX := 0? 
SETSDNAME; ISTKLIH := MAXIS"^K| 
ALLOCiPTi; 

*'» BODYC^JILtPT);"* COMPILE USER PROGRAM 

^ ajc^ :^ :^ 3^ !^ 3$E ijc :9c 3jc :jc :^ ;^ :^ 4c !$c 4c :^ M 

END; 

END "PASCAL". 



# 



• 



1. // JOB »CLASS=e 



^ 2. //ALIO EXEC PGM=ieFBR14 

3. //X no DSNI=WYL.SF. PAS. PSCLLI8,DISP=CNE«, KEEP), UNlTsOISK, 

^ i^. // V3L = SER = WYLOlO,SPACE = ITRK,U.l»ll fRLSE) 

^ 5. //STEPl EXEC ASMGCL,PARM.ASM=«RENT«»PARM.LKED=*NCAL« 

6. //&SM.SYSIM DD * 

^ 7. PSCLMQN CSECT 

9'. * THIS MODULE IS THE ENTRY MOOULEf AND IS RESPONSIBLE FOR 

^ 10, ^ DBTAINIMG CORE, AMD PASSING CONTROL TO THE PASCAL PROGRAM 

^ 11. * 

12. * PROLOGUE 

^ 13. * 

^ 14, SAVE (14.12) ,,* 

15. LR 10,15 BASE REGISTER 

^ 16. USING PSCtM0N,10 

^ 17. GETMAIN R.L V=WORKSIZE 

18. ST l,8fl3) 

19. ST 13, 4M? 

20. LR 13,1 

21. USING W0RKAREA,13 

m 22. * 

^ 23. * GET CORE FOR EXECUTION STACK 

24. * 
^ 25. SETMAIN VU,LA=REOAMT,A=AMTOBfSP=l tMF=lE,GETLISTI 

27. * GIVE BACK 8K FOR BUFFERS, ETC. 

• 29! L 0,RELAMT AMOUNT TO RELEASE 
30. L I, WHERE FROM WHERE 

• 31. A 1,H0WMUCH END OF AREA 

32. S^ 1,0 BEGINNING OF AREA TO GIVE UP 

33. N I, MASK ROUND DOWN TO DOUBLE WORD 

^ 34. 0,MASK2 INSERT SP NUMBER 

^ 35, LA 3t0<0»ll SAVE TOP OF GOTTEN AREA 

36. SH 3,=H«256» 

• 37. FREEMAIN R,LV=< 01 , A=U J 

38. * 

39. * SET UP REGISTERS A LA PASCAL CONVENTIONS 

^ 40. * ANO EXECUTE PASCAL PROGRAM 

^ 41. * 

42. L 2,yH5RE TOP OF STACK 

43. LR 12,2 ADDRESS OF GLOBAL DATA AREA 

44. ST 3,80112) SAVE GETMAIN LIMIT 

45. L 15,=V(*$*MAIN) ADDRESS OF MAIN PROGRAM 
^ 46. BALR 14,15 BRANCH TO PASCAL PROGRAM 
^ 47. ^ 

48. * FREE ALL CORE 

g| 49. * 

^ 50. FREEMAIN R, SP=1 FREES STACK AREA 

51. LR 1,13 ADDRESS OF WORKAREA TO BE FREED 

^ 52. L 13,SAVE+4 GET ADDRESS OF SAVED REGISTERS 

• 53. » FREEMAIN R,LV=W0RKSIZE,A=<1) 
54. RETURN « 14, 12) ,,RG=0 RETURN 

• Sfel PSCLERR OS OH « SIMPLE) RUN-TIME ERROR EXIT 
57, E^^TRY PSCLERR 

^ 58. USING *,15 

^ 59. LA 1,1000(11 ERROR CODE Rl+lOOO 






60. 




ABfNO 


CIUDUMP.STEP 


61. 


* , 






62. 


* DATA 


DEFINITIONS 


63. 


* 






64. 


RE3AMT 


DC 


F« I63 84,'l3l072' 


65. 


RELAMT 


DC 


F«12288« 


66, 


MASK 


DC 


X»FFFFFFF8» 


67. 


MASK 2 


DC 


X'GIOOOOOO' 


68. 




LTORG 




69. 


WORKAREA 


OSECT 




70. 


SAVE 


OS 


18F 


71. 


GETLIST 


GETMAIN »MF = L 


72, 


AMTQB 


DS 


2F 


73. 




ORG 


AMT08 


74. 


WHERE 


DS 


F 


75. 


HOW MUCH 


OS 


F 


76. 


m^KSllE 


EQU 


♦-WORKAREA 


77. 




LTORG 




78. 




EMD 




79. 


//KEO-SYSLMOD 


DD DSN=WYL.SF.PAS 


80. 


// UNIT=!)ISK 


, VOL«SER=WYLOIO 


81. 


//STEP2 


EXEC i 


VSMGCL.PARM.ASM=»R 


82. 


//ASM.SYSIM DO 


* 


83. 


PSCLPUTR 


CSECT 




84. 




SAVE 


114,12 It.* 


85. 




LR 


10*15 


86. 




USING 


PSCLPUTRflO 


87. 




LR 


9,1 


88. 




USING 


FCB,9 


89. 




TM 


FC80FLGS,X»80' 


90. 




B3 


OP END K 


91. 


«t 






92. 


* CODE 


TO OPEN FILE 


93. 


* 






94. 




GETMAIN R,LV=WORKLeNG 


95. 




USING 


WORKAREA, 13 


96. 




ST 


1 , 811 3 ) 


97. 




ST 


13, 4C 1) 


98. 




LR 


13,1 


99. 




MVC 


VrfORKDCBIWORKDCBLJ 


100. 




LA 


7,W0RKDCB 


101. 




USING 


IHA0CB,7 


102. 




MVC 


OCBD0NAM,FC80ONAM 


103. 




OPEN 


(C7),<0UTPUT1 l,MF 


104. 




m 


DCB0FLGS,X«10' 


105. 




8Z 


ABENDO 


106. 




ST 


13,FCBW0RKa 


107, 




LH 


2,DCBLRECL 


108. 




LTR 


2,2 


109. 




8NZ 


*+8 


110. 




LH 


2,0C88LKSI 


III. 




CH 


2,FCBLRECL 


112. 




BNE 


ABENOL 


113. 




01 


FCB0FLGS,X«80» 


114. 




8 


PUT 


115. 




DROP 


7 


116. 


# 






117. 


♦ IF FILE WAS 


OPEN THEN MUST ST 


118. 


* 






119. 


OPHMOK 


L 


l,FCBWRK3 



PARM LIST FOR GETMAIN 
AMOUNT TO BE RELEASED FOR BUFFERS 
TO ROUND DOWN TO OOJBLE WORD 
SU8P00L NUMBER 



SAVE AREA 

GETMAIN PARM LIST 

ANSWER RETURNED FROM GETMAIN 

LOCATION OF OBTAINED AREA 
AMOUNT OBTAINED 
LENGTH OF WORKAREA 



# 

m 



m 
m 



.PSCLLIB(PSCLMON»,OISP=OLD, 
ENT' 



BASE REGISTER 
TELL ASSEMBLER 
FOB POINTER 

IS FILE ALREADY OPEN? 
YES 



GET WORKAREA FOR THIS FILE 
INCLUDES SAVE AREA 
LINK SAVE AREAS 



,DC8 MOVE IN COPY OF OCB 

REMEMBER WHERE IT IS 

MOVE IN FILENAME FROM FCB 
=<E,M0RKLIST1 

SUCCESSFUL OPEN? 

NO-DIE 

SAVE WORK AREA ADDRESS IN FCB 

GET LRECL FROM DOCARO 

0-NOT PRESENT 

GET BLKSIZE INSTEAD 

SAME AS FILE RECORD S IZf? 

NO-OIE 

EVERYTHING OK-SET OPEN FLAG IN FCB 

GO DO PUT 



# 

m 












120. 
121. 
122, 
123. 
124. 
125. 
126. 
127. 
128. 
129. 
130, 
131. 
132. 
133. 
13A. 
135. 
136. 
137. 
138. 
13<?. 
140. 
141. 
142. 
143. 
144. 
145. 
146. 
147. 
148. 
149. 
150. 
151. 
152. 
153. 
154. 
155. 
156. 
157. 
158. 
159. 
160. 
161. 
162. 
163. 
164. 
165. 
166. 
167. 
168. 
169. 
170. 
171, 
172. 
173. 
174. 
175, 
176. 
177. 
178. 
179. 



PUT 
* 

* 



ST 

ST 
LR 
PUT 

RETURN CODE 



1,8(13) 
13 ♦4C n 
13,1 

W0RKDCB,FCB8UFF 



ACTUAL I/O 



L 

RETURN 

* FRR3R EXITS 

* 

ABEMDO 
A8FMDL 



ABEND 
ABEND 
LTORG 

^ DECLARATIONS 

DCB DCS 

WLIST 05>EN 

* 

FCB 

FCBSUFF® 

FCBODNAM 

FCBLRECt 

FC8BUFF 

FC33FLGS 



13,4( 13) 
{ 14,12),»RC=0 



2000 
2001 



DSORG=PS,MACRF={PM) 
t,),MF=L 



DSeCT 

DS 

DS 

DS 

EQU 

EOU 

ORG 

OS 

DS 



FCBMORKa 
FCSCOU^^T 

ilORKAREA DSECT 
WORKSA OS 
W3RKDC8 DCB 
WOR<LIST Q!»EM 
WORKOCBL EOU 
WOR<lEMG EQU 
* 

OCBD 
E^O 
//KE9.SYSLM0D 



A 
CLIO 

H 

EC BLR EC L 

FCBDONAM 

A 

F 



18F 

DS0P.5 = PS,MACRF=f 
f ,i,MF=L 
♦-WORK DCB 
♦-WORKAREA 

DS0R3=PS 



LIST FORM OF OPEN MACRO(ALSO CLOSE) 

FILE CONTROL BLOCK 

POINTER TO BUFFER IN PASCAL DATA AREA 
FILE NAME 

LRECL ACCORDING TO PASCAL 
BUFFER FOLLOWS FCB 
OPEN FLAG 

OVERWRITTEN IN OPEN CODE 
POINTER TO SAVE AREA AND DCB 
NUMBER OF CHAR LEFT IN BUFFER 
^CHARACTER FILES ONLY I 

SAVE AREA AND DCS 



PM) 



OD 



DSN=WYL.SF.PA 
// UMIT=DISK,V0L=SE«-WYL010 
//STEP3 EXEC ASMGCL,PARM.ASM=» 
//ASM.SYSIN DD * 
PSCLGETR CSECT 

SAVE (14,12),,* 

LR 10»15 

US IMG PSCLGETR, 10 

LR 9, I 

USING FCB, 9 

TM FCB0FLGS,X»80' 

80 OPENOK 



* 



CODE TO OPEN FILE 



GETMAIN R,LV=WORKL€NG 
USING WORKAREA.IS 
ST 1,8U3) 

ST 13,4(11 



LIST FORM OF OPEN MACRO! ALSO CLOSE) 
LENGTH OF DCB 
LENGTH OF WORK AREA 



S.PSCLLI8(PSCLPUTRI,DISP=0L0f 
RENT* 



BASE REGISTER 
TELL ASSEMBLER 
FCB POINTER 

IS FILE ALREADY OPEN? 
YES 



GET WORKAREA FOR THIS FILE 
INCLUDES SAVE AREA 
LINK SAVE AREAS 



ISO. LR 13,1 

181. mC W0RK0C8fMORK0CBLI,0C8 MOVE IN COPY OF DC8 

182. Lh 7,W0RK0CB REMEMBER WHERE IT IS 

183. USING IHADCB,7 

184. »4VC DCBO0NAM,FC8ODNAM MOVE IN FILENAME FROM FC8 

185. DPEM (f 71,nNPUTn .MF=|E,WORKLISTI 

186. TM DCB0FLGS,X«10« SUCCESSFUt. OPEN? 

187. 87. ABENDO NO-DIE 

188. ST 13*FCBW0RK3 SAVE WORK AREA ADDRESS IN FCB 

189. LH 2fOCBLRECL GET LRECL FROM DDCARD 

190. LTR 2.2 0-NOT PRESENT 

191. BM? *+8 

192. LH 2,DCBBLKSI SET BLKSIZE INSTEAD 

193. CH 2tFCBLRFCL SAME AS FILE RECORD SIZE? 

194. m^ ABEND L NO-DIE 

195. 01 FC80FLGS,X«80' EVERYTHING OK-SET OPEN FLAG IN FCB 

196. B GET GO DO GET 

197. D^OP 7 

198. * 

199. » IF FILE WAS OPEN THEN MUST STILL DO ENTRY CODE 

200. * 

201. OPEMOK L UFCBWORKa 

202. ST l,8U3) 

203. ST 13,4C1) 

204. LR 13.1 

205. GET GET WORKOCB .FCBBUFF ACTUAL I/O 

206. * 

207. # RETURN CODE 

208. * 

209. L 13.4(13) 

210. RETURN f 14.12) . ,RC=0 

211. * 

212. * ERROR EXITS 

213. * 

214. ABE^iDO ABEND 2000 

215. ABENOL ABEND 2001 

216. LTORG 
?17, * 

218. * DECLARATIONS 

219. ♦= 

220. DCB DCB DS0R5=PS ,MACRF»{GM) 

221. WLIST OPEN «.),MF=L LIST FORM OF OPEN MACRO! ALSO CLOSE) 

222. ^^ 

223. FCB DSECT FILE CONTROL BLOCK 

224. FCBBUFFa DS A POINTER TO BUFFER IN PASCAL DATA AREA 

225. FCBODNAM DS CLIO FILE NAME 

226. FC8LRECL DS H LRECL ACCORDING TO PASCAL 

227. FCB8UFF EQU * BUFFER FOLLOWS FCB 

228. FCB3FLGS EOU FCBLRECL OPEN FLAG 

229. ORG FCBODNAM OVERWRITTEN IN OPEN CODE 

230. FCSfciORKS DS A POINTER TO SAVE AREA AND DCB 

231. FC8C0UNT DS F NUMBER OF CHAR LEFT IN BUFFER 

232. * (CHARACTER FILES ONLY! 

233. * 

234. WORKAREA DSECT SAVE AREA AND OCB 

235. WORKSA OS 18F 

236. WO^KDCB OCB DS0R5=PS,MACRF=(GMI 

237. WOR<LIST OPEN U),MF=L LIST FORM OF OPEN MACRO! ALSO CLOSE! 

238. W0RX0C8L EQU ''^WORKDCB LENGTH OF DCB 

239. W05?KLENG EQU *-WORKAREA LENGTH OF WORKAREA 



• 



• 



240. * 

241. DCBD OSORG = PS 
24?. EMD 

243. //KEO.SVSLMOD 00 DSN=WYL. SF. PA S. PSCLLI BCPSCLGeiR) , DISP^OLDt 

244. // U^IT»DISK,V0L=SER=WYL010 



# 



n is% 



